Copier feuille 1 coller feuille 2

Le 09/01/2017 à 14:43

Bonjour,

Je bloque sur un point de la macro. Je voudrais copier les données de la feuille 1 vers la feuille 2 en fonction de l'adresse trouvée (dans ce cas c.adress et d.adress). Existe t'il un moyen peut être plus simple pour effectuer cette opération ?

Merci d'avance

Sub test()
Dim c As Range, d As Range

With Sheets("feuil1").Range("A1:A500")
    Set c = .Find("ARC", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
With Sheets("Feuil2").Range("B1:B500")
    Set d = .Find("ARCANDE", LookIn:=xlValues)
    If Not d Is Nothing Then
        firstAddress = d.Address
        Do
        Sheets("feuil2").Select
[color=#FF0000]        Sheets("feuil1").c.Offset(5, 0).Value = Sheets("Feuil2").d.Offset(4, 0).Value
        Sheets("feuil1").c.Offset(5, 1).Value = Sheets("Feuil2").d.Offset(4, 1).Value 
        Sheets("feuil1").c.Offset(5, 2).Value = Sheets("Feuil2").d.Offset(4, 2).Value
        Sheets("feuil1").c.Offset(5, 3).Value = Sheets("Feuil2").d.Offset(4, 3).Value [/color]
            Set d = .FindNext(d)
        Loop While Not d Is Nothing And d.Address <> firstAddress
    End If
End With
End Sub

Le 10/01/2017 à 08:12