VBA - Problème avec la création d'une boucle
Bonjour à tous,
Je tente de créer une macro qui répond à mes besoins, mais je bloque sur la boucle.
J'ai une extraction Excel qui provient d'une base Access pour lequel un même client peut avoir jusqu'a 10 lignes d'articles différents (chaque article ayant 6 informations qui lui sont propre). Afin de mettre en place des TCD, je souhaite regrouper ces données ainsi :
ID client ... type désignation état qté prix_unitaire prix_totale
1 Test ... Tab
1 Test ... Chevet
2 Bla .... Chaise etc..
Voici mon début de code
Sub Test()
Application.WorksheetFunction.CountA(Range("A2:A100")) = Max
Dim Max As Integer
For i = 2 To Max + 1
For j = 2 To Max + 1
If i < Max +1 Then
Range("Ai:Ii").Select
Selection.Copy
Sheets("Sortie").Select
Range("Aj").Select
ActiveSheet.Paste
If Worksheets("R_Test").Cells(i, 10).Value <> "" Then Range("Ji:Oi").Select
Selection.Copy
Sheets("Sortie").Select
Range("Jj").Select
ActiveSheet.Paste
Exit For
End If
End If
Next
End SubMais j'ai des messages d'erreurs au lancement
J'ai mis un onglet "Résultat attendu" pour que cela soit plus parlant.
Merci par avance de votre aide et bonne journée à tous
Bonjour AcuraDreams, bonjour le forum,
Peut-être comme ça :
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim PL As Range 'déclare la variable PL (PLage)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Set OS = Worksheets("R_Test") 'définit l'onglet source OS (à adapter)
Set OD = Worksheets("Résultat Attendu") 'définit l'onglet destination OD (à adapter)
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données dans l'onglet destination OD
Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL
NL = PL.Rows.Count 'définit le nombre de lignes NL de la plage PL
For I = 2 To NL 'boucle sur toutes les lignes I de la plage PL (en partant de la seconde)
If OS.Cells(I, "J") <> "" Then 'condition 1 : si la cellule ligne I colonne J n'est pas vide
Set dest = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
'copie la plage des colonnes A à O de la ligne I et la colle dans DEST
OS.Range(OS.Cells(I, "A"), OS.Cells(I, "O")).Copy dest
End If 'fin de la condition 1
If OS.Cells(I, "P") <> "" Then 'condition 2 : si la cellule ligne I colonne P n'est pas vide
Set dest = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
'copie la plage des colonne A à I de la ligne I et la colle dans DEST
OS.Range(OS.Cells(I, "A"), OS.Cells(I, "I")).Copy dest
'copie la plage des colonnes P à U de la ligne I et la colle dans DEST décalée de 9 colonnes à droite
OS.Range(OS.Cells(I, "P"), OS.Cells(I, "U")).Copy dest.Offset(0, 9)
End If 'fin de la condition 2
Next I 'prochaine ligne de la boucle
End SubBonjour ThauThème,
Je viens de faire le test et c'est parfait, un grand merci pour ton aide
Bonne journée