Copie partiel d'une ligne VBA

Bonjour,

J'ai le code suivant qui me permet de copier toute mes lignes à partir de ma sheet2 vers ma sheet3 lorsque j'ai 1 dans ma colonne D. Cependant, la macro copie toute la ligne. J'ai seulement besoin de l'information de la colonne A à D.

J'aimerai avoir une idée comment y arrivé.

Sub Copie()
    Dim c As Range
    Dim j As Integer

    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("Sheet2")
    Set Target = ActiveWorkbook.Worksheets("Sheet3")

    j = Sheets("sheet3").Range("A1000000").End(xlUp).Row + 1
    For Each c In Source.Range("D2:D100000")   ' Compte 100000 ligne
        If c = "1" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c

End Sub

Merci De votre aide

Bonjour

A tester

Sub Copie()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

  Set Source = ActiveWorkbook.Worksheets("Sheet2")
  Set Target = ActiveWorkbook.Worksheets("Sheet3")

  j = Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Row + 1
  For Each c In Source.Range("D2:D" & Source.Range("D" & Rows.Count).End(xlUp).Row)     ' Compte 100000 ligne
    If c = "1" Then
      Source.Range("A" & c.Row).Resize(1, 4).Copy Target.Range("A" & j)
      j = j + 1
    End If
  Next c
End Sub

fontionnne parfaitement

Merci de ton aide