[XL-2016] Macro VBA Copie Lignes sous conditions

1 pièce(s) jointe(s)

Macro VBA Copie Lignes sous conditions

Bonjour,

Je commence en VBA et après avoir parcouru le site depuis plusieurs semaines, je n’arrive pas à avancer. Je remercie d’avance les personnes qui auront la gentillesse de m’accorder un peut de temps à la résolution de mon problème.

J’ai besoin de faire une macro qui copie chaque ligne de la feuille Data dont la colonne
B contient le texte « BQ » et dont le premier chiffre de la colonne D contient le chiffre « 4 » et dont la colonne « J » contient un code. Chaque ligne doit être copiés dans la feuille correspondant au code qui figure dans la colonne « J ».

Ci-joint mon tableau EXCEL comme exemple.

Merci d'avance

Bonjour,
Je n'ouvre pas les classeurs joints voir Fichiers joints dans les discussions mais d'après tes explication, il est très simple de résoudre cela en VBA avec la méthode AdvancedFilter de l'objet Range (Filtres avancés)

Si tu ne connais pas les filtres avancés d'excel, je te conseille la lecture de ce tutoriel Les filtres avancés ou élaborés dans Excel

Etape par étape

Exporter une liste sans les doublons de la colonne J (Les codes) à l'aide de la méthode AdvancedFilter
Créer une zone des critères calculés (Dans la fonctions ET(Test sur la colonne B, Colonne D, et pour la colonne J tester l'égalité avec le premier élément de la liste sans doublons)
A l'intérieur d'une boucle

Extraire les lignes, suivant les conditions décrites, vers la feuille correspondant au code
Supprimer le premier élément de la liste sans doublons (le deuxième élément va ainsi remonter et deviendra donc le nouveau critère

Cette contribution pourra t'inspirer

Macro VBA Copie Lignes sous conditions

Bonjour Philippe,

Merci pour les informations, j'ai trouvé de l'aide sur un autre forum et voici le code que l'on m'a proposé et qui fonctionne très bien.

Si ça peut aider d'autres personnes, le voici :

Merci encore et bon weekend

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub CopiLigne()
'Déclaration des variables
Dim c As Variant
Dim Li As Integer, i As Integer, Feuille As String
Dim w As Worksheet
 
Application.ScreenUpdating = False '..................................................Désactive la mise à jour de l'écran (gain de temps) ON aurait pu s'en passer dans le cas présent
 
For i = 1 To Sheets.Count '...........................................................Boucle sur les feuilles (sheets.count compte le nombre de feuille dans le classeur)
   If Sheets(i).Name <> "Data" And Sheets(i).Name <> "Tempo" And Sheets(i).Name <> "Accueil" And Sheets(i).Name <> "TVA" Then '...................On exclus la feuilles nommée "Dat" et "Tempo"
      Sheets(i).Range("A4:G1000").ClearContents '.....................................On efface le contenu des cellules sur la plage A4:G1000
   End If
Next i
 
With Sheets("Data") '.................................................................Avec la feuille Data
   For Each c In .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row) '............Boucle sur la plage de cellules (trouve la dernière ligne du tableau pour trouver le nombre de lignes)
      If c = "OD" And Left(c.Offset(, 2), 1) = 4 And c.Offset(, 8) <> "" Then '.......Test si c = "BQ" et si le 1er caractère en partant de la _
                                                                                      gauche est un 4 pour la colonne"D" C;offset(0,2) decale de 2 colonne _
                                                                                       Et si la cellule colonne B + 8 soit colonne J n'est pas vide (offset(0,8) décale de 8 colonnes)
 
         Feuille = c.Offset(, 8) '....................................................La variabale feuille prend le nom du contenu de la cellule colonne J (offset(0,8) décale de 8 colonnes)
         Set w = Sheets(Feuille) '....................................................Instanciation de la feuille
         Li = w.Range("A" & Rows.Count).End(xlUp).Row + 1 '...........................Trouve la première ligne vide et affecte le numéro de ligne +1 pour l'écriture des données
         .Range(.Cells(c.Row, "B"), .Cells(c.Row, "G")).Copy w.Cells(Li, "A") '.......Copie les données de la feuille data vers la feuille (nommée en colonne J) en colonne A comme point de recopie
         .Cells(c.Row, "J").Copy w.Cells(Li, "G") '...................................Copie les données de la feuille data vers la feuille (nommée en colonne J) en colonne G comme point de recopie
      End If
       If c = "BQ" And Left(c.Offset(, 2), 1) = 4 And c.Offset(, 8) <> "" Then '.......Test si c = "BQ" et si le 1er caractère en partant de la _
                                                                                      gauche est un 4 pour la colonne"D" C;offset(0,2) decale de 2 colonne _
                                                                                       Et si la cellule colonne B + 8 soit colonne J n'est pas vide (offset(0,8) décale de 8 colonnes)
 
         Feuille = c.Offset(, 8) '....................................................La variabale feuille prend le nom du contenu de la cellule colonne J (offset(0,8) décale de 8 colonnes)
         Set w = Sheets(Feuille) '....................................................Instanciation de la feuille
         Li = w.Range("A" & Rows.Count).End(xlUp).Row + 1 '...........................Trouve la première ligne vide et affecte le numéro de ligne +1 pour l'écriture des données
         .Range(.Cells(c.Row, "B"), .Cells(c.Row, "G")).Copy w.Cells(Li, "A") '.......Copie les données de la feuille data vers la feuille (nommée en colonne J) en colonne A comme point de recopie
         .Cells(c.Row, "J").Copy w.Cells(Li, "G") '...................................Copie les données de la feuille data vers la feuille (nommée en colonne J) en colonne G comme point de recopie
      End If
   Next
End With
Application.ScreenUpdating = True ' ...................................................Réactive la mise à jour de l'écran
End Sub