Boucle sur cellule

Bonjour a tous et a toutes voici mon code

Sub Copier_Décaler()

Dim Lig&, DerL&

DerL = Feuil4.Range("A" & Rows.Count).End(3).Row + 1

For Lig = 1 To 100

If Feuil1.Cells(Lig, 24) = "BLN" Then

Worksheets("BLN").Rows(2).Insert Shift:=xlDown

Worksheets("Activité").Range("B14:D14,S14,X14").Copy Worksheets("BLN").Range("A2:G2")

End If

Next

End Sub

Mon soucis est que

Worksheets("Activité").Range("B14:D14,S14,X14").Copy Worksheets("BLN").Range("A2:G2")

je ne copie que des cellules specifiées or je voudrais copier pour chaque boucle les cellules "B14:D14,S14,X14"

"B14:D14,S14,X14" vers Range("A2:G2")

"B15:D15,S15,X15" vers Range("A3:G3")

etc

de plus je ne comprends pas pourquoi excel copie 2 fois les donnees dans "BLN"

merci du coup de main

Bonjour,

Voici ce que je te propose mais il y a un problème entre les cellules que tu copie (5) et les cellules que tu colle (7).

Sub Copier_Décaler()

Dim Lig&, DerL&, z As Integer

DerL = Feuil4.Range("A" & Rows.Count).End(3).Row + 1

z = 0

For Lig = 1 To 100
    If Feuil1.Cells(Lig, 24) = "BLN" Then
        z = z + 1
        Worksheets("BLN").Rows(2).Insert Shift:=xlDown
        Worksheets("Activité").Range("B14:D14,S14,X14").Copy Worksheets("BLN").Range("A2:G2")
        'Colonne B
        Worksheets("BLN").Cells(2, 1) = Worksheets("Activité").Cells(14 + z, 2)
        'Colonne C
        Worksheets("BLN").Cells(2, 2) = Worksheets("Activité").Cells(14 + z, 3)
        'Colonne D
        Worksheets("BLN").Cells(2, 3) = Worksheets("Activité").Cells(14 + z, 4)
        'Colonne S
        Worksheets("BLN").Cells(2, 4) = Worksheets("Activité").Cells(14 + z, 19)
        'Colonne X
        Worksheets("BLN").Cells(2, 5) = Worksheets("Activité").Cells(14 + z, 24)

    End If
Next
End Sub

hello

ca ne fonctionne pas ca me copie

"B14:D14,S14,X14" vers Range("A2:G2")

"B15:D15,S15,X15" vers Range("A3:G3")

mais ne respecte pas la condition If Feuil1.Cells(Lig, 24) = "BLN" Then

Je me suis peut etre mal expliqué

en fait If Feuil1.Cells(1, 24) = "BLN" alors il copie la ligne "B14:D14,S14,X14" vers Range("A2:G2")

If Feuil1.Cells(2, 24) = "BLN" alors il copie la ligne "B15:D15,S15,X15" vers Range("A3:G3")

If Feuil1.Cells(3, 24) = "BLN" alors il copie la ligne "B16:D16,S16,X16" vers Range("A4:G4")

etc

Oups, si je n'enlève pas la ligne ça ne vas pas le faire lol

Sub Copier_Décaler()

Dim Lig&, DerL&, z As Integer

DerL = Feuil4.Range("A" & Rows.Count).End(3).Row + 1

z = 0

For Lig = 1 To 100
    If Feuil1.Cells(Lig, 24) = "BLN" Then
        z = z + 1
        Worksheets("BLN").Rows(2).Insert Shift:=xlDown
        'Worksheets("Activité").Range("B14:D14,S14,X14").Copy Worksheets("BLN").Range("A2:G2")
        'Colonne B
        Worksheets("BLN").Cells(2, 1) = Worksheets("Activité").Cells(14 + z, 2)
        'Colonne C
        Worksheets("BLN").Cells(2, 2) = Worksheets("Activité").Cells(14 + z, 3)
        'Colonne D
        Worksheets("BLN").Cells(2, 3) = Worksheets("Activité").Cells(14 + z, 4)
        'Colonne S
        Worksheets("BLN").Cells(2, 4) = Worksheets("Activité").Cells(14 + z, 19)
        'Colonne X
        Worksheets("BLN").Cells(2, 5) = Worksheets("Activité").Cells(14 + z, 24)

    End If
Next
End Sub

A tester

donc cela fonctionne a peu pres

il me sort sur la feuille BLN une valeur qui ne correspond pas a BLN je ne comprends pas pourquoi

Et voici

Bonne continuation

merci beaucoup de cette aide precieuse