Copie sous condition
Bonjour,
Faisant mes débuts avec les macro VBA je butte sur le pb suivant:
Le but:
Copier des cellules de la feuille "Source" B2,C2,D2 vers la feuille "Cible" dans B2,C2,D2 à condition que le nom de la première cellule A2 soit identique.
(Il s'agit de compléter des cellules vides à partir d'une autre feuille a condition que le nom soit égal)
Pour chaque changement de cellule Nom de la feuille Source (A+1) on devra retester toutes les cellules de la feuille Cible à partir de A2.
Je suppose qu'il faut une double boucle.
Voici ma macro qui pose problème:
Sub Copie sous confition
' *** Positionement sur la feuille "Source"
Sheets("Source").select
' *** Déclaration des Variables X et Y = Cellules à tester
Dim x as String
Dim y as String
' *** Tant que Y n'est pas vide les instructions suivante sont executées
*** Do While IsEmpty(y) = False
' *** Si la cellule A2 de la feuille "Source" = à la cellule A2 de la feuille "Cible"
If Sheets("Source").Cells(x, 1).Value = Sheets("Cible").Cells(x, 1).Value Then
' *** copie de B2,C2,D2, de la feuille "Source" sur B2,C2,D2, de la feuille "Cible"
Then Cells(x, 4).Value = Cells(x, 9).Value
Sheets("Source").Cells(x, 2).Value = Sheets("Cible").Cells(x, 2).Value
Sheets("Source").Cells(x, 3).Value = Sheets("Cible").Cells(x, 3).Value
Sheets("Source").Cells(x, 4).Value = Sheets("Cible").Cells(x, 4).Value
' *** si nom incrementation de Y +1
Else y = y + 1
' *** si nom incrementation de x +1
' *** Boucle retest x = y
Loop
Si y = vide sortie de la boucle
' *** incrementation de x
x = x+1
End Sub
Merci pour votre aide
Bonjour,
Essaie comme cela :
Sub Copie_sous_condition()
Dim x As String, y As String
Dim WsC As Worksheet
Dim Cel As Range
Set WsC = Sheets("Cible")
With Sheets("Source")
For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
If Cel.Value = WsC.Range(Cel.Address).Value Then
Cel.Offset(0, 1).Resize(, 3).Copy WsC.Cells(Cel.Row, 2)
End If
Next Cel
End With
Set WsC = Nothing
End SubA+
Merci Frangy
Cela marche partiellement c'est à dire que si les noms dans la colonne A sont dans l'ordre c'est ok
Si non cela ne marche pas
Voici en pièce jointe le fichier
Avec le fichier, je comprends mieux
Sub Copie_sous_condition()
Dim x As String, y As String
Dim WsC As Worksheet
Dim Cel As Range, C As Range
Set WsC = Sheets("Cible")
With Sheets("Source")
For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
Set C = WsC.Columns(1).Find(Cel.Value, , xlValues, xlWhole)
If Not C Is Nothing Then
Cel.Offset(0, 1).Resize(, 3).Copy C.Offset(0, 1)
End If
Next Cel
End With
Set WsC = Nothing
End SubA+
Super cela marche !
La puissance de VBA (si on le maitrise) est impressionnante.
Merci Frangy
je viens d'essayer sur un gros fichier cela marche mais cela me demande des manip en plus.
Je m'explique:
Ma feuille cible contient des dizaines de colonne
Je voudrait imposait la copie en partant de telle à telle colonne
Exemple:
Feuille source reste de de B à F et feuille Cible de M à Q
En modifiant la ligne ci-dessous je joue sur le nb de cellule copiées
"Cel.Offset(0, 1).Resize(, 6).Copy C.Offset(0, 1)
Par contre je n'arrive pas à modifier la colonne de départ
Bien entendu il faudra modifier la macro à la demande
Si tu as une idée je suis preneur
Merci encore pour ton aide précieuse !
PS: En pièce jointe le fichier avec les explications
Bonjour,
Pour effectuer la copie des cellules sources, tu dois indiquer où se trouve la cellule de départ (position par rapport à la colonne A) et la dimension de la plage.
Si, par exemple, tu souhaites copier la plage qui va de B à F, tu vas écrire :
Cel.Offset(0,1).Resize(,5) qui désigne la plage qui débute par la cellule décalée de 1 colonne par rapport à Cel et qui comporte 5 colonnes.
Autre exemple avec la plage E à G, tu vas écrire :
Cel.Offset(0,4).Resize(,3) qui désigne la plage qui débute par la cellule décalée de 4 colonnes par rapport à Cel et qui comporte 3 colonnes.
Ensuite, pour le collage, il suffit que tu indiques où se trouve le début de la plage.
Exemple : C.Offset(0, 1) pour copier à partir de la colonne B (cellule décalée de 1 colonne par rapport à la cellule C).
Un copier/coller de la plage B à F vers la plage M à Q va s'écrire :
Cel.Offset(0,1).Resize(,5).Copy C.Offset(0, 12)
A+
Merci beaucoup Frangy.
Je vais mettre en pratique ta solution
Super !