VBA copie de données d'une feuille à une autre

Bonjour,

Dans mon fichier, les cellules sont mobiles, le numéro de cellule n'est donc pas viable. Il faut que je copie une ligne parmi des références en se basant sur le nom de la cellule en colonne "A".

Je n'arrive pas à copier les cellules adjacentes à la cellule intéressante de la colonne "A"

Voici le code permettant de trouver les cellules de la colonne "A" et de les copier vers l'autre feuille :

Sub exlpratique()

j = 1

For Each c In Range("animaux")

        If CStr(c.Value) = "Lion" Then 'je mets lion juste pour commencer mon code, il sera remplacer par Chat plus tard, je n'ai pas trouver d'autre méthode..
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Select
        ActiveSheet.Name = "recopie"
        ElseIf CStr(c.Value) = "Chat" Or CStr(c.Value) = "Rat" Or CStr(c.Value) = "Cheval" Then
        ActiveSheet.Range("A" & j).Value = c.Value
        j = j + 1
        End If

Next

End Sub

Et le fichier ci joint.

Merci d'avance pour vos retours ;)

Bonsoir Sanctume, le forum,

A tester....la feuille "recopie" est déjà présente (on l'efface puis on écrit les données)

Sub Bouton2_Cliquer()
 Dim tablo, tabloR(), k%

   tablo = Sheets("Feuil1").Range("A1").CurrentRegion

        k = 0
    For i = 1 To UBound(tablo, 1)
     If tablo(i, 1) Like "Chat" Or tablo(i, 1) Like "Rat" Or tablo(i, 1) Like "Cheval" Then
      ReDim Preserve tabloR(1 To 2, 1 To k + 1)
       tabloR(1, 1 + k) = tablo(i, 1)
       tabloR(2, 1 + k) = tablo(i, 2)
        k = k + 1
     End If
    Next i

    With Sheets("recopie")
     .Range("A1").CurrentRegion.ClearContents
      On Error Resume Next
     .Range("A1").Resize(UBound(tabloR, 2), 2) = Application.Transpose(tabloR)
     .Activate
    End With
End Sub

Sinon, si tu tiens à conserver ton code :

ActiveSheet.Range("A" & j).Value = c.Value
ActiveSheet.Range("B" & j).Value = c.Offset(0, 1).Value

Cordialement,