copier cellules dans une autre feuille avec meme réf.

Dim lig As Long
    Dim choixLig As Long


    
  ' Trouver la ligne
    choixLig = 0
       
     For lig = 4 To 2560
    
     If Sheets("feuil3").Range("A" & lig) = Sheets("feuil1").Range("A4") Then choixLig = lig
     If choixLig = lig Then
     Sheets("feuil3").Select
     lig = Range("B65536").End(xlUp).Row + 1
     Cells(lig, 1) = X
     choixLig = lig: Exit For
     End If
    Next lig
  
    Cells(choixLig, 1) = X

'    If choixLig = 0 Then
'        MsgBox "L'enregistrement n'est pas possible", vbCritical + vbOKOnly, "Erreur"
'        Exit Sub
'    End If

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellule As Range
Dim dc1 As Long


If Not Intersect(Target, Sheets(Target.Worksheet.Name).Range("b4:b4")) Is Nothing Then
If Target = "" Then Exit Sub
With Sheets("Feuil3")
dc1 = .Cells(Target.Offset(0, -1) + 3, Rows(Target.Offset(0, -1) + 3).Cells.Count).End(xlToLeft).Column + 1
.Cells(Target.Offset(0, -1) + 3, dc1) = "X"
End With
With Sheets("Feuil2")
.Cells(Target.Offset(0, -1) + 3, 3) = Target.Value
End With
End If



End Sub

Sub essai()
Dim target As Range
Dim dc1 As Long
With Sheets("Feuil3")
Set target = .Range("b4") ' à modifier si on change de cellule

dc1 = .Cells(target.Offset(0, -1) + 3, Rows(target.Offset(0, -1) + 3).Cells.Count).End(xlToLeft).Column + 1
.Cells(target.Offset(0, -1) + 3, dc1) = "X"
End With
With Sheets("Feuil2")
.Cells(target.Offset(0, -1) + 3, 3) = target.Value
End With

End Sub