Discussion :

[Vadorblanc]

Bonjour
Ce code insère une ligne vide à chaque fois que le chiffre change en colonne A.
Maintenant je voudrais copier par groupe de 6 lignes colonne C et les coller en colonne G, puis 6 lignes colonne C en partant d'en haut et les coller en colonne H, etc...selon N lignes variable en colonne C, et ainsi pour tous les groupes de la colonne A.

Colonnes A B C D sont les originales, et les colonnes G H I J K L ... sont remplies par la deuxième condition qu'il me manque.

Cette deuxième condition est faite jusqu'à présent manuellement car je n'ai pas trouvé le moyen de l'automatiser par une boucle.
Merci d'avance.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub boucle()
 
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = LastLig To 2 Step -1
        If .Range("A" & i).Value <> Range("A" & i - 1).Value Then .Rows(i).Insert
 
    Next i
End With
End Sub

A B C D G H I

1 x a x a c f
1 x a x a d f
1 x a x a d f
1 x b x b d h
1 x b x b d
1 x b x b e
1 x c x
1 x d x
1 x d x
1 x d x
1 x d x
1 x e x
1 x f x
1 x f x
1 x f x
1 x h x

2 x a x a c
2 x a x a d
2 x a x a d
2 x b x b d
2 x b x b d
2 x b x b
2 x c x
2 x d x
2 x d x
2 x d x
2 x d x

3 x a x a c f
3 x a x a d
3 x a x a d
3 x b x b d
3 x b x b d
3 x b x b e
3 x c x
3 x d x
3 x d x
3 x d x
3 x d x
3 x e x
3 x f x

[mercatog]

Bonsoir Vadorblanc

Si j'ai bien compris, ci joint proposition à tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Boucle()
Dim LastLig As Long, i As Long, Deb As Long, Fin As Double
Dim j As Integer, n As Integer
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = LastLig To 2 Step -1
        If .Range("A" & i).Value <> Range("A" & i - 1).Value Then
            Deb = i
            n = 1 + (LastLig - Deb + 1) \ 6
            For j = 1 To n
                Fin = Application.Min(Deb + 6 * j - 1, LastLig)
                .Range("C" & Deb + 6 * (j - 1) & ":C" & Fin).Copy .Cells(Deb, 6 + j)
            Next j
            .Rows(i).Insert
            LastLig = Deb - 1
        End If
    Next i
End With
End Sub

[Vadorblanc]

Bonsoir Mercatog

Tu m'étonneras toujours, ta boucle extraordinaire fonctionne admirablement bien, comme à ton habitude, t'as vraiment acquis un savoir qui est à la hauteur de ta passion, et je suis un fervent admirateur de tous ce que tu fais sur ce forum, d'ailleurs mes points acquis le sont en grande partie par les votes que je t'ai donné ce qui prouve toute ma façon de te remercier. Dommage en réussissant du premier coup je ne pourrais que te voter qu' une fois sur mon message, mais j'irais à la pêche sur d'autres...
Un grand merci à toi.
Très cordialement

[mercatog]

Re Vadorblanc
Pour ne pas insérer une ligne en ligne 2 (premier groupe), on doit ajouter une petite condition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If i > 2 Then .Rows(i).Insert

Dommage en réussissant du premier coup je ne pourrais que te voter qu' une fois sur mon message, mais j'irais à la pêche sur d'autres...

PS. T'es génial, en réussissant à faire ressortir un grand fou rire.