insertion de lignes avec formats et formules

Le
Pascal
Bonjour,
je sollicite vos connaissances à nouveau
DESCRIPTION
j'ai 2 feuilles : feuil2 et feuil7
la feuille 7 est une liste transportable de noms prenoms adresses etc.
B=NOM C=PRENOM etc et s'arrête à la colonne L
le feuille 2 est sur le même modèle
B=NOM C=PRENOM jusqu'à la colonne L tout est identique d'autre infos
viennent se greffer après la colonne L

je souhaiterai
mettre à jour la feuille2 à partir de la feuille 7
CADire vérifier les noms /prenoms si le nom est déjà présent dans la
feuille2, par prudence on remplace les coordonnées (si une mise à jour dans
feuile 7 au niveau adresse par exemple à été faite)
si le nom de la feuille 7 n'est pas présent dans la feuille 2, on insère une
ligne en copiant les formats et les formules et on ajoute ce nouveau nom
ne voyant pas comment m'y prendre vraiment, je me suis dit : en 2 temps
1er) parcours de feuil7 et ajout si nom pas trouvé dans feuil2
2ème) Reparcours mais en mode comparaison/suppression à partir de la
feuille2

j'ai fait ce qui suit( pas terminé et pas fonctionnel) soucis déjà en mode
insertion mais bon.
si kkun peut m'aider la dessus je l'en remercie d'avance
. *****************************************************************
MaxMembre vaut 1000
******************************************************************
Dim F As Long, c As Long
Dim MaxlstDidier As Long
Dim MaxlstMenu As Long
Dim N°Ligne

MaxlstFeuil7 = Application.WorksheetFunction.CountA(Feuil7.Range("b3:b" &
MaxMembre))
MaxlstMenu = Application.WorksheetFunction.CountA(Feuil2.Range("b3:b" &
MaxMembre))

Application.EnableEvents = False

With Feuil7
For F = 3 To Maxlstfeuil7
For c = F To MaxlstMenu
'vérification sur Nom/Prenom/DateNaissance
If .Range("b" & F) = Feuil2.Range("b" & c) And _
.Range("c" & F) = Feuil2.Range("c" & c) And _
.Range("h" & F) = Feuil2.Range("h" & c) Then
Exit For
Else
Range("A" & F & ":" & "AL" & F).Select
Selection.Insert Shift:=xlDown
'No de la ligne insérée
N°Ligne = ActiveCell.Row
'Ligne où se trouvent les formules à copier
Rows(F + 1).Select
Selection.Copy
Rows(N°Ligne).Select
'collage avec formats et formules
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone
'importation des coordonnées du nouveau membre

'incrémente le compteur
MaxlstMenu = MaxlstMenu + 1
exit For
End If
Next c
Next F
End With 'feuil7

'appel de tri
Call tri
'Réactivation
Application.EnableEvents = True
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #16410931
Bonjour.
Regarde le classeur à l'adresse :
http://cjoint.com/?hzsQaD5QVp
Je n'ai pris en considération que les colonnes A à L. Je me suis servi des
cellules M1:M3 de Feuil7 pour me faciliter le travail. On peut utiliser
n'importe quelles autrescellules à condition de modifier le code en
conséquence. la formule en M1 est une formule matricielle :

Sub test()
Dim sh7 As Worksheet, sh2 As Worksheet, c As Range
Dim Plage7 As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh2 = Sheets("Feuil2")
Set sh7 = Sheets("Feuil7")
Set Plage7 = Range(sh7.[B2], sh7.[B65536].End(xlUp))
For Each c In Plage7
sh7.[M2] = c.Value
sh7.[M3] = c.Offset(, 1).Value
If sh7.[M1] = 0 Then
Ligne = sh2.[B65000].End(xlUp).Row + 1
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(Ligne, 1)
Else
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(sh7.[M1],
1)
End If
Next c
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel
"Pascal" ,com> a écrit dans le message de news:
%
Bonjour,
je sollicite vos connaissances à nouveau
DESCRIPTION
j'ai 2 feuilles : feuil2 et feuil7
la feuille 7 est une liste transportable de noms prenoms adresses etc....
B=NOM C=PRENOM etc... et s'arrête à la colonne L
le feuille 2 est sur le même modèle
B=NOM C=PRENOM jusqu'à la colonne L tout est identique d'autre infos
viennent se greffer après la colonne L

je souhaiterai...
mettre à jour la feuille2 à partir de la feuille 7
CADire vérifier les noms /prenoms si le nom est déjà présent dans la
feuille2, par prudence on remplace les coordonnées (si une mise à jour
dans feuile 7 au niveau adresse par exemple à été faite)
si le nom de la feuille 7 n'est pas présent dans la feuille 2, on insère
une ligne en copiant les formats et les formules et on ajoute ce nouveau
nom
ne voyant pas comment m'y prendre vraiment, je me suis dit : en 2 temps
1er) parcours de feuil7 et ajout si nom pas trouvé dans feuil2
2ème) Reparcours mais en mode comparaison/suppression à partir de la
feuille2

j'ai fait ce qui suit( pas terminé et pas fonctionnel) soucis déjà en
mode insertion mais bon....
si kkun peut m'aider la dessus je l'en remercie d'avance
. *****************************************************************
MaxMembre vaut 1000
******************************************************************
Dim F As Long, c As Long
Dim MaxlstDidier As Long
Dim MaxlstMenu As Long
Dim N°Ligne

MaxlstFeuil7 = Application.WorksheetFunction.CountA(Feuil7.Range("b3:b"
& MaxMembre))
MaxlstMenu = Application.WorksheetFunction.CountA(Feuil2.Range("b3:b" &
MaxMembre))

Application.EnableEvents = False

With Feuil7
For F = 3 To Maxlstfeuil7
For c = F To MaxlstMenu
'vérification sur Nom/Prenom/DateNaissance
If .Range("b" & F) = Feuil2.Range("b" & c) And _
.Range("c" & F) = Feuil2.Range("c" & c) And _
.Range("h" & F) = Feuil2.Range("h" & c) Then
Exit For
Else
Range("A" & F & ":" & "AL" & F).Select
Selection.Insert Shift:=xlDown
'No de la ligne insérée
N°Ligne = ActiveCell.Row
'Ligne où se trouvent les formules à copier
Rows(F + 1).Select
Selection.Copy
Rows(N°Ligne).Select
'collage avec formats et formules
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone
'importation des coordonnées du nouveau membre

'incrémente le compteur
MaxlstMenu = MaxlstMenu + 1
exit For
End If
Next c
Next F
End With 'feuil7

'appel de tri
Call tri
'Réactivation
Application.EnableEvents = True
End Sub








Pascal
Le #16411881
Hello Daniel,
merci pour la rapidité de réponse
je ne comprend pas la formule.......
SOMME((Feuil2!B2:B65000þuil7!M2)*(Feuil2!C2:C65000þuil7!M3)*LIGNE(2:65000))
pourrais tu m'éclairer
merci


"Daniel.C" discussion :
Bonjour.
Regarde le classeur à l'adresse :
http://cjoint.com/?hzsQaD5QVp
Je n'ai pris en considération que les colonnes A à L. Je me suis servi des
cellules M1:M3 de Feuil7 pour me faciliter le travail. On peut utiliser
n'importe quelles autrescellules à condition de modifier le code en
conséquence. la formule en M1 est une formule matricielle :

Sub test()
Dim sh7 As Worksheet, sh2 As Worksheet, c As Range
Dim Plage7 As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh2 = Sheets("Feuil2")
Set sh7 = Sheets("Feuil7")
Set Plage7 = Range(sh7.[B2], sh7.[B65536].End(xlUp))
For Each c In Plage7
sh7.[M2] = c.Value
sh7.[M3] = c.Offset(, 1).Value
If sh7.[M1] = 0 Then
Ligne = sh2.[B65000].End(xlUp).Row + 1
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(Ligne, 1)
Else
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(sh7.[M1],
1)
End If
Next c
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel
"Pascal" ,com> a écrit dans le message de news:
%
Bonjour,
je sollicite vos connaissances à nouveau
DESCRIPTION
j'ai 2 feuilles : feuil2 et feuil7
la feuille 7 est une liste transportable de noms prenoms adresses etc....
B=NOM C=PRENOM etc... et s'arrête à la colonne L
le feuille 2 est sur le même modèle
B=NOM C=PRENOM jusqu'à la colonne L tout est identique d'autre infos
viennent se greffer après la colonne L

je souhaiterai...
mettre à jour la feuille2 à partir de la feuille 7
CADire vérifier les noms /prenoms si le nom est déjà présent dans la
feuille2, par prudence on remplace les coordonnées (si une mise à jour
dans feuile 7 au niveau adresse par exemple à été faite)
si le nom de la feuille 7 n'est pas présent dans la feuille 2, on insère
une ligne en copiant les formats et les formules et on ajoute ce nouveau
nom
ne voyant pas comment m'y prendre vraiment, je me suis dit : en 2 temps
1er) parcours de feuil7 et ajout si nom pas trouvé dans feuil2
2ème) Reparcours mais en mode comparaison/suppression à partir de la
feuille2

j'ai fait ce qui suit( pas terminé et pas fonctionnel) soucis déjà en
mode insertion mais bon....
si kkun peut m'aider la dessus je l'en remercie d'avance
. *****************************************************************
MaxMembre vaut 1000
******************************************************************
Dim F As Long, c As Long
Dim MaxlstDidier As Long
Dim MaxlstMenu As Long
Dim N°Ligne

MaxlstFeuil7 = Application.WorksheetFunction.CountA(Feuil7.Range("b3:b"
& MaxMembre))
MaxlstMenu = Application.WorksheetFunction.CountA(Feuil2.Range("b3:b" &
MaxMembre))

Application.EnableEvents = False

With Feuil7
For F = 3 To Maxlstfeuil7
For c = F To MaxlstMenu
'vérification sur Nom/Prenom/DateNaissance
If .Range("b" & F) = Feuil2.Range("b" & c) And _
.Range("c" & F) = Feuil2.Range("c" & c) And _
.Range("h" & F) = Feuil2.Range("h" & c) Then
Exit For
Else
Range("A" & F & ":" & "AL" & F).Select
Selection.Insert Shift:=xlDown
'No de la ligne insérée
N°Ligne = ActiveCell.Row
'Ligne où se trouvent les formules à copier
Rows(F + 1).Select
Selection.Copy
Rows(N°Ligne).Select
'collage avec formats et formules
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone
'importation des coordonnées du nouveau membre

'incrémente le compteur
MaxlstMenu = MaxlstMenu + 1
exit For
End If
Next c
Next F
End With 'feuil7

'appel de tri
Call tri
'Réactivation
Application.EnableEvents = True
End Sub












Daniel.C
Le #16412161
La macro écrit le nom en M2 et le prénom en M3. Pour chaque valeur de
Feuil2!B2:B65000, pour Feuil2!B2:B65000þuil7!M2, si l'égalité est
vérifiée,la formule renvoie 1, sinon, 0. Il en va de même pour le prénom,
Feuil2!C2:C65000þuil7!M3 renverra 1 si l'égalité est vérifiée. Si, pour la
même ligne, l'égalité est vérifiée pour le nom et le prénom, on aura 1 x1,
soit 1 et 0 x 1 ou 1 x 0 ou encore 0 x 0, soit 0 dans tous les autres cas.
Pour trouver la ligne correspondante, je multiplie par LIGNE(2:65000) soit
2,3,4 etc. Si j'ai obtenu auparavant :
0, 0, 0, 1
la multiplpication par le numéro de ligne donne
0 x 2
0 x 3
0 x 4
1 x 5
et la somme de toute ces opérations donne 5.
En espérant avoir été clair... ce dont je ne suis pas persuadé.
Daniel
"Pascal" ,com> a écrit dans le message de news:

Hello Daniel,
merci pour la rapidité de réponse
je ne comprend pas la formule.......
SOMME((Feuil2!B2:B65000þuil7!M2)*(Feuil2!C2:C65000þuil7!M3)*LIGNE(2:65000))
pourrais tu m'éclairer
merci


"Daniel.C" discussion :
Bonjour.
Regarde le classeur à l'adresse :
http://cjoint.com/?hzsQaD5QVp
Je n'ai pris en considération que les colonnes A à L. Je me suis servi
des cellules M1:M3 de Feuil7 pour me faciliter le travail. On peut
utiliser n'importe quelles autrescellules à condition de modifier le code
en conséquence. la formule en M1 est une formule matricielle :

Sub test()
Dim sh7 As Worksheet, sh2 As Worksheet, c As Range
Dim Plage7 As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh2 = Sheets("Feuil2")
Set sh7 = Sheets("Feuil7")
Set Plage7 = Range(sh7.[B2], sh7.[B65536].End(xlUp))
For Each c In Plage7
sh7.[M2] = c.Value
sh7.[M3] = c.Offset(, 1).Value
If sh7.[M1] = 0 Then
Ligne = sh2.[B65000].End(xlUp).Row + 1
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(Ligne, 1)
Else
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(sh7.[M1],
1)
End If
Next c
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel
"Pascal" ,com> a écrit dans le message de news:
%
Bonjour,
je sollicite vos connaissances à nouveau
DESCRIPTION
j'ai 2 feuilles : feuil2 et feuil7
la feuille 7 est une liste transportable de noms prenoms adresses
etc....
B=NOM C=PRENOM etc... et s'arrête à la colonne L
le feuille 2 est sur le même modèle
B=NOM C=PRENOM jusqu'à la colonne L tout est identique d'autre infos
viennent se greffer après la colonne L

je souhaiterai...
mettre à jour la feuille2 à partir de la feuille 7
CADire vérifier les noms /prenoms si le nom est déjà présent dans la
feuille2, par prudence on remplace les coordonnées (si une mise à jour
dans feuile 7 au niveau adresse par exemple à été faite)
si le nom de la feuille 7 n'est pas présent dans la feuille 2, on insère
une ligne en copiant les formats et les formules et on ajoute ce nouveau
nom
ne voyant pas comment m'y prendre vraiment, je me suis dit : en 2 temps
1er) parcours de feuil7 et ajout si nom pas trouvé dans feuil2
2ème) Reparcours mais en mode comparaison/suppression à partir de la
feuille2

j'ai fait ce qui suit( pas terminé et pas fonctionnel) soucis déjà en
mode insertion mais bon....
si kkun peut m'aider la dessus je l'en remercie d'avance
. *****************************************************************
MaxMembre vaut 1000
******************************************************************
Dim F As Long, c As Long
Dim MaxlstDidier As Long
Dim MaxlstMenu As Long
Dim N°Ligne

MaxlstFeuil7 =
Application.WorksheetFunction.CountA(Feuil7.Range("b3:b" & MaxMembre))
MaxlstMenu = Application.WorksheetFunction.CountA(Feuil2.Range("b3:b"
& MaxMembre))

Application.EnableEvents = False

With Feuil7
For F = 3 To Maxlstfeuil7
For c = F To MaxlstMenu
'vérification sur Nom/Prenom/DateNaissance
If .Range("b" & F) = Feuil2.Range("b" & c) And _
.Range("c" & F) = Feuil2.Range("c" & c) And _
.Range("h" & F) = Feuil2.Range("h" & c) Then
Exit For
Else
Range("A" & F & ":" & "AL" & F).Select
Selection.Insert Shift:=xlDown
'No de la ligne insérée
N°Ligne = ActiveCell.Row
'Ligne où se trouvent les formules à copier
Rows(F + 1).Select
Selection.Copy
Rows(N°Ligne).Select
'collage avec formats et formules
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone
'importation des coordonnées du nouveau membre

'incrémente le compteur
MaxlstMenu = MaxlstMenu + 1
exit For
End If
Next c
Next F
End With 'feuil7

'appel de tri
Call tri
'Réactivation
Application.EnableEvents = True
End Sub















Pascal
Le #16412351
hello Daniel,
Si j'ai compris ! donc tu as été clair.
je te remercie pour ton aide précieuse
Pascal


"Daniel.C" discussion : #
La macro écrit le nom en M2 et le prénom en M3. Pour chaque valeur de
Feuil2!B2:B65000, pour Feuil2!B2:B65000þuil7!M2, si l'égalité est
vérifiée,la formule renvoie 1, sinon, 0. Il en va de même pour le prénom,
Feuil2!C2:C65000þuil7!M3 renverra 1 si l'égalité est vérifiée. Si, pour
la même ligne, l'égalité est vérifiée pour le nom et le prénom, on aura 1
x1, soit 1 et 0 x 1 ou 1 x 0 ou encore 0 x 0, soit 0 dans tous les autres
cas. Pour trouver la ligne correspondante, je multiplie par LIGNE(2:65000)
soit 2,3,4 etc. Si j'ai obtenu auparavant :
0, 0, 0, 1
la multiplpication par le numéro de ligne donne
0 x 2
0 x 3
0 x 4
1 x 5
et la somme de toute ces opérations donne 5.
En espérant avoir été clair... ce dont je ne suis pas persuadé.
Daniel
"Pascal" ,com> a écrit dans le message de news:

Hello Daniel,
merci pour la rapidité de réponse
je ne comprend pas la formule.......
SOMME((Feuil2!B2:B65000þuil7!M2)*(Feuil2!C2:C65000þuil7!M3)*LIGNE(2:65000))
pourrais tu m'éclairer
merci


"Daniel.C" discussion :
Bonjour.
Regarde le classeur à l'adresse :
http://cjoint.com/?hzsQaD5QVp
Je n'ai pris en considération que les colonnes A à L. Je me suis servi
des cellules M1:M3 de Feuil7 pour me faciliter le travail. On peut
utiliser n'importe quelles autrescellules à condition de modifier le
code en conséquence. la formule en M1 est une formule matricielle :

Sub test()
Dim sh7 As Worksheet, sh2 As Worksheet, c As Range
Dim Plage7 As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh2 = Sheets("Feuil2")
Set sh7 = Sheets("Feuil7")
Set Plage7 = Range(sh7.[B2], sh7.[B65536].End(xlUp))
For Each c In Plage7
sh7.[M2] = c.Value
sh7.[M3] = c.Offset(, 1).Value
If sh7.[M1] = 0 Then
Ligne = sh2.[B65000].End(xlUp).Row + 1
Range(c.Offset(, -1), c.Offset(, 10)).Copy sh2.Cells(Ligne,
1)
Else
Range(c.Offset(, -1), c.Offset(, 10)).Copy
sh2.Cells(sh7.[M1], 1)
End If
Next c
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel
"Pascal" ,com> a écrit dans le message de news:
%
Bonjour,
je sollicite vos connaissances à nouveau
DESCRIPTION
j'ai 2 feuilles : feuil2 et feuil7
la feuille 7 est une liste transportable de noms prenoms adresses
etc....
B=NOM C=PRENOM etc... et s'arrête à la colonne L
le feuille 2 est sur le même modèle
B=NOM C=PRENOM jusqu'à la colonne L tout est identique d'autre infos
viennent se greffer après la colonne L

je souhaiterai...
mettre à jour la feuille2 à partir de la feuille 7
CADire vérifier les noms /prenoms si le nom est déjà présent dans la
feuille2, par prudence on remplace les coordonnées (si une mise à jour
dans feuile 7 au niveau adresse par exemple à été faite)
si le nom de la feuille 7 n'est pas présent dans la feuille 2, on
insère une ligne en copiant les formats et les formules et on ajoute ce
nouveau nom
ne voyant pas comment m'y prendre vraiment, je me suis dit : en 2 temps
1er) parcours de feuil7 et ajout si nom pas trouvé dans feuil2
2ème) Reparcours mais en mode comparaison/suppression à partir de la
feuille2

j'ai fait ce qui suit( pas terminé et pas fonctionnel) soucis déjà en
mode insertion mais bon....
si kkun peut m'aider la dessus je l'en remercie d'avance
. *****************************************************************
MaxMembre vaut 1000
******************************************************************
Dim F As Long, c As Long
Dim MaxlstDidier As Long
Dim MaxlstMenu As Long
Dim N°Ligne

MaxlstFeuil7 =
Application.WorksheetFunction.CountA(Feuil7.Range("b3:b" & MaxMembre))
MaxlstMenu = Application.WorksheetFunction.CountA(Feuil2.Range("b3:b"
& MaxMembre))

Application.EnableEvents = False

With Feuil7
For F = 3 To Maxlstfeuil7
For c = F To MaxlstMenu
'vérification sur Nom/Prenom/DateNaissance
If .Range("b" & F) = Feuil2.Range("b" & c) And _
.Range("c" & F) = Feuil2.Range("c" & c) And _
.Range("h" & F) = Feuil2.Range("h" & c) Then
Exit For
Else
Range("A" & F & ":" & "AL" & F).Select
Selection.Insert Shift:=xlDown
'No de la ligne insérée
N°Ligne = ActiveCell.Row
'Ligne où se trouvent les formules à copier
Rows(F + 1).Select
Selection.Copy
Rows(N°Ligne).Select
'collage avec formats et formules
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone
'importation des coordonnées du nouveau membre

'incrémente le compteur
MaxlstMenu = MaxlstMenu + 1
exit For
End If
Next c
Next F
End With 'feuil7

'appel de tri
Call tri
'Réactivation
Application.EnableEvents = True
End Sub



















Publicité
Poster une réponse
Anonyme