Passer des lignes lorsque des valeurs sont différentes

Question

J'ai trouvé pas mal d'infos pour m'aider à résoudre ce soucis qui parait simple, mais je suis débutant et pour une raison que j'ignore;, ma macro ne marche pas! Je tente de screener la feuille ETIQUETTES où j'ai copié collé des valeurs d'une autre feuille d'origine, et de passer une ligne: - a chaque fois que la colonne A de l'onglet ETIQUETTES change - toutes les 10 lignes s'il y a plus de 10 valeurs identiques en colonne A Pour le moment je suis bloqué au premier point, avec le code ci dessous. La macro tourne bien mais les lignes ne sont pas créées... Sub generationetiquettes() Sheets("COMMANDES").Range("A:A").Copy Sheets("ETIQUETTES").Range("A1").PasteSpecial xlPasteValues Sheets("COMMANDES").Range("E:E").Copy Sheets("ETIQUETTES").Range("B1").PasteSpecial xlPasteValues Sheets("COMMANDES").Range("G:G").Copy Sheets("ETIQUETTES").Range("C1").PasteSpecial xlPasteValues Sheets("COMMANDES").Range("F:F").Copy Sheets("ETIQUETTES").Range("D1").PasteSpecial xlPasteValues Sheets("ETIQUETTES").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Sheets("ETIQUETTES").Range("A1").EntireRow.Delete Dim wk_fichier As Workbook Dim ws_commandes As Worksheet Dim ws_etiquettes As Worksheet Dim lastrow_etiquettes As Long Set wk_fichier = ActiveWorkbook Set ws_commandes = wk_fichier.Worksheets("COMMANDES") Set ws_etiquettes = wk_fichier.Worksheets("ETIQUETTES") lastrow_etiquettes = ws_etiquettes.Cells(Rows.Count, 1).End(xlUp).Row Dim i As Long For i = 2 To lastrow_etiquettes If Range("a" & i).Value &lt;&gt; Range("a" & i - 1).Value Then Range("a" & i).EntireRow.Insert Next Endsub &lt;\&gt; Avez vous une idée? Merci!...

gmb · Accepted Answer

Macro commentée : Option Explicit Dim fc As Worksheet, tabloC, tabloE(), tabloP Dim i&, j&, k&, t&, colC, lnD& Sub Etiquettes() Set fc = Sheets("COMMANDES") tabloC = fc.Range("A1:G" & fc.Range("A" & Rows.Count).End(xlUp).Row) 'On met dans une variable tableau 'la partie des données du tableau de la feuille " 'Commandes" qui va nous être utile ReDim tabloP(1 To UBound(tabloC, 1) - 1, 1 To 4) 'On définit une variable tableau provisoire destinée à 'les données du résultat colC = Array(1, 5, 7, 6) 'colonnes à récupérer dans le tableau source k = 0 'initialisation de la variable For i = 2 To UBound(tabloC, 1) 'Boucle qui va permettre de récupérer les données du résultat 'présentées dans les colonnes désirées If tabloC(i, 1) &lt;&gt; "" Then 'On ne s'intéresse qu'au lignes qui en colonne 1 ne sont pas vides For j = 0 To 3 tabloP(k + 1, j + 1) = tabloC(i, colC(j)) 'et on les place dans tabloP Next j k = k + 1 'on incrémente k pour passer à ligne suivante de tabloP End If Next i Cells.ClearContents 'On initialise la feuille de résultat Range("A1").Resize(k, 4) = tabloP 'On y écrit tabloP : c'est le tableau recherché su 4 colonnes 'mais comme il a la même dimension que tabloC, il a beaucoup 'de lignes vides en fin de tableau Erase tabloP 'On vide le tableau provisoire ' tabloP = Range("A1").CurrentRegion 'On le redéfinit à la dimension du tableau qu'on vient d'écrire 'sur la feuille de calcul k = 0: t = 0 'On initialise 2 variables la première va permettre de changer de 'ligne dans le tabloP, la deuxième va compter les 10 valeurs maxi lnD = 1 'lnD sera la ligne de la première ligne de chaque nouveau groupe 'de lignes For i = 1 To UBound(tabloP, 1) 'On va passer toutes les lignes de tabloP If tabloP(i, 1) &lt;&gt; tabloP(lnD, 1) Or t = 10 Then 'si la valeur en colonne 1 de laligne considérée 'n'a pas la même valeur que celle de la première 'ligne du groupe ou si c'est la 10° du groupe, alors... k = k + 1 'On incrémente k lnD = i 'On indique que i devient la première ligne du nouveau 'group t = 0 'et que l'on repart à zéro pour le comptage des lignes 'du groupe End If 'fin de la condition ReDim Preserve tabloE(1 To 4, 1 To k + 1) 'on définit le tablo résultat que l'on écrira in finé sur la 'feuille "Etiquette" (d'où le E !) 'Ce tabloE doit être transposé (lignes et colonnes y sont 'inversées) car on ne peut faire varier que les données 'de la dernière dimension For j = 1 To 4 'On reporte dans tabloE les valeurs de tabloP tabloE(j, k + 1) = tabloP(i, j) Next j k = k + 1 'on incrémente k pour changer de ligne dans tabloE t = t + 1 'on incrémente t pour le comptage des lignes du nouveau groupe Next i Range("A1").Resize(UBound(tabloE, 2), 4) = Application.Transpose(tabloE) 'On reporte les données de TabloE 'sur la feuille de calcul à partir de A1 End Sub Bye ...

AntoineDL · Answer

Quand on souhaite insérer une ligne dans un tableau lors d'un changement de valeurs, le plus simple est de lire les données de bas en haut et non de haut en bas. Une proposition est donc de remplacer : For i = 2 To lastrow_etiquettes par For i = lastrow_etiquettes To 2 Step -1...

gmb · Answer

Bonjour à tous Un essai à tester, si j'ai bien compris. Te convient-il ? Option Explicit Dim fc As Worksheet, tabloC, tabloE(), tabloP Dim i&, j&, k&, t&, colC, lnD& Sub Etiquettes() Set fc = Sheets("COMMANDES") tabloC = fc.Range("A1:G" & fc.Range("A" & Rows.Count).End(xlUp).Row) ReDim tabloP(1 To UBound(tabloC, 1) - 1, 1 To 4) colC = Array(1, 5, 7, 6) k = 0 For i = 2 To UBound(tabloC, 1) If tabloC(i, 1) &lt;&gt; "" Then For j = 0 To 3 tabloP(k + 1, j + 1) = tabloC(i, colC(j)) Next j k = k + 1 End If Next i Cells.ClearContents Range("A1").Resize(k, 4) = tabloP Erase tabloP tabloP = Range("A1").CurrentRegion k = 0: t = 0 lnD = 1 For i = 1 To UBound(tabloP, 1) If tabloP(i, 1) &lt;&gt; tabloP(lnD, 1) Or t = 10 Then k = k + 1 lnD = i t = 0 End If ReDim Preserve tabloE(1 To 4, 1 To k + 1) For j = 1 To 4 tabloE(j, k + 1) = tabloP(i, j) Next j k = k + 1 t = t + 1 Next i Range("A1").Resize(UBound(tabloE, 2), 4) = Application.Transpose(tabloE) End Sub Bye ...