Recopie automatiquement sous excel - VB

Private Sub Worksheet_Change(ByVal Target As Range)  
If Not Intersect(Target, Columns("A")) Is Nothing Then  
     lig2 = Target.Row  
     With Sheets(1)  
          lig1 = .Cells.Rows.Count  
          On Error GoTo erreur  
          lig1 = .Columns("A").Find(Target.Value, .Cells(lig1, "A"), xlValues).Row  
          Range(Cells(lig2, "B"), Cells(lig2, "C")) = .Range(.Cells(lig1, "E"), .Cells(lig1, "F")).Value  
     End With  
End If  
Exit Sub  
erreur:  
     MsgBox " le numéro " & Target & " est inconnu dans la liste des dossiers", vbCritical  
End Sub  

Sub cherche()
Dim Trouve As Range
Dim Valeur_cherchee, Valeur_trouvee As String
With Sheets("Feuil2")
    Valeur_cherchee = .Cells(1, 1)
End With
With Sheets("Feuil1")
    Set Trouve = .Columns(1).Cells.Find(what:=Valeur_cherchee)
        If Trouve Is Nothing Then
            MsgBox "Pas trouvé"
        Else
            Valeur_trouvee = Trouve.Offset(0, 1).Value
        End If
End With
With Sheets("Feuil2")
    .Cells(1, 2) = Valeur_trouvee
End With
Set Trouve = Nothing
End Sub