Discussion :

[Nico Co]

Bonjour,
N'étant pas expert vba, j'ai besoin d'aide.
Je souhaite sur ma feuille 1 copier les lignes 9 à 12 et les coller à chaque fois qu'au sein de la colonne B à partir de la ligne 13 j'ai une valeur différente à celle du dessous.
Sachant que mon résultat à partir de la ligne 13 n'est pas figé (seul les lignes 1 à 12 reste fixent).

J'ai cherché sur les forums je n'ai pas trouvé la solution.
La macro ci-dessous permet d'insérer des lignes. Mais pas les lignes 9 à 12.
L'autre problème c'est qu'elle démarre en au de la colonne au lieu de la ligne 13.

1.For Each elm In ActiveWorkbook.ActiveSheet.UsedRange.Columns("B").Cells
2. If elm.Value <> "" And elm.Value <> elm.Offset(1).Value Then
3. elm.Offset(1).EntireRow.Insert xlDown
4. End If
5. Next elm
6. Rows("13:13").Select
7. Selection.Delete Shift:=xlUp

J'ai intégré une fichier PJ afin d'illustrer mon besoin. En feuille 1 la présentation des données de départ et en feuil2 le résultat attendu.
Merci

[gnain]

Bonjour,
ce code copie ce que vous voulez dans la feuil3

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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub test()
 
    With Sheets("Feuil3").Cells
        .ClearContents
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("A1").Select
    End With
 
    k = 12
 
    With Sheets("Feuil1")
        .Range("A9:N12").Copy Destination:=Sheets("Feuil3").Range("A9")
 
        For i = 13 To .Range("A" & .Rows.Count).End(xlUp).Row
            k = k + 1
            If .Cells(i, 2).Value <> .Cells(i + 1, 2).Value Then
                .Range("A" & i & ":N" & i).Copy Destination:=Sheets("Feuil3").Range("A" & k)
                k = k + 1
                .Range("A9:N12").Copy Destination:=Sheets("Feuil3").Range("A" & k)
 
                k = k + 3
 
            Else
                .Range("A" & i & ":N" & i).Copy Destination:=Sheets("Feuil3").Range("A" & k)
            End If
 
        Next
    End With
 
MsgBox "fin"
 
End Sub

[Nico Co]

Bonjour,

Merci pour ce retour.
Est-ce qu'il est possible que tout s'exécute sur le feuil1 sans qu'à la fin on est une dernière copie des lignes 9 à 12 qui n'a pas lieu d’être puisqu'il n'y a plus de donnée à présenter ?

[gnain]

Bonjour,
quand la feuil3 est fini d'être généré
il suffit de copier la feuil3 dans feuil1
puis supprimé le contenu de la feuil3

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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub test()
 
    With Sheets("Feuil3").Cells
        .ClearContents
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("A1").Select
    End With
 
    k = 12
 
    With Sheets("Feuil1")
        .Range("A9:N12").Copy Destination:=Sheets("Feuil3").Range("A9")
 
        For i = 13 To .Range("A" & .Rows.Count).End(xlUp).Row
            k = k + 1
            If .Cells(i, 2).Value <> .Cells(i + 1, 2).Value Then
                .Range("A" & i & ":N" & i).Copy Destination:=Sheets("Feuil3").Range("A" & k)
                k = k + 1
                If i <> .Range("A" & .Rows.Count).End(xlUp).Row Then
                    .Range("A9:N12").Copy Destination:=Sheets("Feuil3").Range("A" & k)
 
                    k = k + 3
                End If
 
            Else
                .Range("A" & i & ":N" & i).Copy Destination:=Sheets("Feuil3").Range("A" & k)
            End If
 
        Next
    End With
 
    With Sheets("Feuil1").Cells
        .ClearContents
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("A1").Select
    End With
 
    Sheets("Feuil3").Cells.Copy Destination:=Sheets("Feuil1").Range("A1")
    Sheets("Feuil3").Cells.Delete
 
MsgBox "fin"
 
End Sub

[Nico Co]

Ok merci