Ajouter une deuxième condition

Version imprimable

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:

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

Bonsoir Vadorblanc

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

Code:

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

29/06/2011, 23h04
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. :ccool::ccool::ccool:
Très cordialement
29/06/2011, 23h13
mercatog

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

Code:

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

Citation:

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.