Copie cellules si valeur dans colonne

Bonjour,

Je souhaite copier les cellules d'une feuille vers une autres, si la valeur de la première colonne de la 1er feuille est "z"

Sub ZoneTexte1_Clic()
'

Dim Lig     As Long
Dim NbrLig  As Long
Dim NumLig  As Long

Sheets("Feuil2").Activate ' feuille de destination

NumLig = 0
With Sheets("Feuil1")     ' feuille source
NbrLig = .Cells(65536, 1).End(xlUp).Row
 For Lig = 1 To NbrLig
  If .Cells(Lig, 1).Value = "z" Then
     .Range(Cells(Lig, 1), Cells(Lig, 4)).Select
     Selection.Copy

    NumLig = NumLig + 1
    Cells(NumLig, 1).Select
    ActiveSheet.Paste
  End If
 Next
End With

End Sub

vinc

Bonjour

Une méthode (parmi d'autres)

Sub ZoneTexte1_Clic()
Dim NumLig As Long
Dim J As Long

  With Sheets("Feuil1")           ' A partir de la feuille source
    For J = 1 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("A" & J) = "z" Then
        NumLig = NumLig + 1
        .Range("A" & J & ":D" & J).Copy Sheets("Feuil2").Range("A" & NumLig)
      End If
    Next J
  End With
End Sub