Rapatrier des infos d'une feuille sur une autre

Bonjour,

Je dois récupérer des codes pour des références ; dans ma Feuil1 (1202 DA), à traiter, j'ai en colonne C la liste des Articles du fournisseur, dans ma feuil2 (Tables) j'ai les articles que je veux avec leur code.

Je veux donc récupérer les codes de la Tables et les rapatrier dans ma feuil1 quand les articles existent.

Attention, aucune des tables n'est triées.

Voici le code que j'ai essayé, mais j'ai des pb...

Sub ComparRapatri()
'MAcro Dan McRdg le 27/06/2012
Dim Tabl As Worksheets  'Source
Dim Plage As Range, Id As Range 'Eléménts à rechercher Plage et id
Dim lg As Integer       'Variable N° de ligne correspondant à l'Id recherché
'BUG ENTRE WORKBOOKS ET SHEETS
Set Tabl = ThisWorkbook.Worksheet("Tables")'Dans le fichier où se trouve les données
With Sheets("Tables")  'et dans la feuille concernée

Set Plage = .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row) 'Ds le fichier à Traiter je délimite la Plage de recherche

For Each Id In Plage    'Pour chaque Id de la Plage
    On Error Resume Next
    'Lg = WorksheetFunction.Match, méthode =>expression.Match(Arg1, Arg2, Arg3)
    'où Arg1 = Val_Cherchée,Arg2 = Matrice_Recherche, Ag3 Facult = Type de rech : -1,0 ou 1 (-1 petite val, 0 val égale, 1 Val gde)
    'Retourne le N° de la ligne qui est égale à l'Id si non trouvé renvoie 0
    lg = WorksheetFunction.Match(Id, Tabl.Range("B4:B" & Tabl.Range("B" & Rows.Count).End(xlUp).Row), 0)
    If lg > 0 Then  'Si la ligne existe
        'Copie de la feuille Tables/ColonC ligne lg et colle sur 1204 DA/col D lign Id
        Tabl.Range("C" & lg + 2).Copy .Range("D" & Id.Row)
    End If
    lg = 0  'Remise du compteur Lg à 0
Next
End With    'si la liste des Id a été testé fin
End Sub

J'ai déjà utiliser ce code pour rappatrier des données d'un autre fichier ouvert et ça fonctionnait ; j'ai du mal avec l'utisation des collections, objets, Workbooks, Workbook, thisWorkbook, Sheet, Sheets...

Je vous joints un fichier test.

Merci

34comparrapatri.xlsm (25.93 Ko)

Bonjour,

Option Explicit
Sub ComparRapatri()
'MAcro Dan McRdg le 27/06/2012
Dim Tabl As Worksheet  'Source
Dim Plage As Range, Id As Range 'Eléménts à rechercher Plage et id
Dim Lg As Double       'Variable N° de ligne correspondant à l'Id recherché
    Set Tabl = ThisWorkbook.Worksheets("Tables")   'Dans le fichier où se trouve la source
    With ThisWorkbook.Worksheets("1204 DA")  'et dans la feuille concernée
        Set Plage = .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row) 'Ds le fichier à Traiter je délimite la Plage de recherche
        For Each Id In Plage    'Pour chaque Id de la Plage
            On Error Resume Next
            'Lg = WorksheetFunction.Match, méthode =>expression.Match(Arg1, Arg2, Arg3)
            'où Arg1 = Val_Cherchée,Arg2 = Matrice_Recherche, Ag3 Facult = Type de rech : -1,0 ou 1 (-1 petite val, 0 val égale, 1 Val gde)
            'Retourne le N° de la ligne qui est égale à l'Id si non trouvé renvoie 0
            Lg = WorksheetFunction.Match(Trim(Id), Tabl.Range("B1:B" & Tabl.Range("B" & Rows.Count).End(xlUp).Row), 0)
            If Id <> "" And Lg > 0 Then 'Si la ligne existe
                'Copie de la feuille Tables/ColonC ligne lg et colle sur 1204 DA/col D lign Id
                Tabl.Range("C" & Lg).Copy Id.Offset(0, 1)
            End If
            Lg = 0  'Remise du compteur Lg à 0
        Next
    End With    'si la liste des Id a été testé fin
End Sub

A+

Merci Frangy,

C'est parfait, juste une modif pour tenir compte que le tableau source commence en ligne 4:

               Tabl.Range("C" & Lg + 3).Copy Id.Offset(0, 1)    '+3 car la liste commence en ligne 4

Merci encore et très bientôt je pense...

juste une modif pour tenir compte que le tableau source commence en ligne 4

Attention, cela dépend de la définition de la plage

Lg = WorksheetFunction.Match(Trim(Id), Tabl.Range("B1:B" & Tabl.Range("B" & Rows.Count).End(xlUp).Row), 0)

A+

Bonjour, Frangy,

Merci pour la précision, j'avais effectivement aussi modifié cette ligne de code

 (Tabl.Range("B4:B & ...
Rechercher des sujets similaires à "rapatrier infos feuille"