Comparer 2 feuilles et copier une cellule de feuille 2 à feuille1, si égalité de réf.

[Toine45]

Bonjour a tous
Débutant en VBA, y aurait-il une âme charitable, pour venir à mon secours pour la finalisation d’une macro ?
Cela fait plusieurs jours que je rame…. et je tourne en rond
Merci beaucoup par avance, si quelqu’un accepte de perdre un peu de temps sur mon problème.

Voici ce que je désire effectuer :
Macro pour Excel 2003
Sur 2 Fichiers (classeurs) Excel contenant plusieurs feuilles (5 ou 6)
But de la macro :
Comparer 2 feuilles différentes et extraire des données de la feuille 4 du classeur 2 pour les copier en feuille 3 du classeur 1

Classeur 1, Feuille 3 :
Colonne A : référence (Que l’on retrouve éventuellement en colonne B de la feuille 4, mais pas dans le même ordre)
Colonne B : Quantité
Colonne C : Vide  On doit y coller les données de la cellule F de la feuille 4 du classeur 2, s’il y a correspondance entre les références des 2 feuilles
Colonne D : Désignation
Plusieurs autres colonnes

Classeur 2, Feuille 4
Colonne A : Quantité
Colonne B : Référence (Que l’on retrouve éventuellement en colonne A de la feuille 3, mais pas dans le même ordre)
Colonne C
Colonne D
Colonne E
Colonne F : N° de casier, que l’on doit copier en face de sa référence, feuille 3, colonne C, en face de sa référence, si celle-ci est trouvée.
Colonne G

Je désirerais comparer la feuille 3 du classeur 1 avec la feuille 4 du classeur 2 et, si une référence de la colonne A de la feuille 3 est trouvée, dans la colonne B de la feuille 4 : copier les données de la cellule F de la feuille 4 du classeur 2 (se trouvant sur la même ligne que la référence cherchée), dans la cellule C de la feuille 3 du classeur 1 (en face de cette même référence).
Si la référence n’est pas trouvée dans la feuille 4, ne rien copier.
-------------------

J’ai réussi à faire une macro qui fonctionne, mais je voudrais effectuer le choix des répertoires, des fichier, des feuilles et des colonnes à comparer, ainsi que les colonnes cibles et destination et éventuellement une plage de colonne à copier (exemple : colonne D à G à copier dans K à N), en passant par une boîte de dialogue, afin de ne pas être obligé de modifier la macro à, chaque fois que je change de fichier, surtout si c’est une autre personne qui s’en sert et qui ne connait pas le VBA.
Ce serait beaucoup plus pratique et conviviale et ça me permettrais d’essayer de comprendre le fonctionnement et pouvoir éventuellement réappliquer ce principe de boîte de dialogue, pour d’autres macros)

Je voudrais avoir aussi la possibilité de faire cette comparaison / copie, sur 2 feuilles différentes, dans un même classeur, ainsi que dans la même feuille.


(Le choix des colonnes peut être une colonne (F) pour copie de la cellule F dans K,
ou une plage (E : G) pour copie des cellules E, F, G dans X, Y, Z. (si plage de 3 cellules de départ choisie : obligation de sélectionner 3 cellules d’arrivée (ou copie à partir de la colonne désignée sur les x cellules suivantes.

Ci-dessous mon code :

Sub inventaire_9()
'- compare la cellule "A2" de la colonne "A" feuille 3 ("Essai") classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille 4 ("Kolbus") du classeur "Pieces Machines"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule (C 2) de la feuille 3 ("Essai") du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne ("J, ligne x ") de la feuille 4 ("Kolbus") du classeur "Pieces Machines" dont la valeur de référence est la même en colonne "B".
 'Sinon reprendre la comparaison a la cellule "A3" et ce, jusqu'à la fin de la colonne "A"
'Travail sur 2 feuilles dans 2 classeurs différents)

'Définition ==================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet

'Chemin ====================
Set F_A = Workbooks("Inventaire-Essai.xls").Sheets("essai")
Set F_B = Workbooks("Pieces Machines.xls").Sheets("Kolbus")

'Comparaison =================
For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp))
'Pour chaque cellule de A
'Cel = cellules de références de feuille 3

    If Not (IsEmpty(Cel)) Then
    'si Cel n'est pas vide
    
        Set Cel_A = F_B.Columns(2).Find(Cel)    'Columns(2)= colonne B
        'fixer Cel_a en tant cellule trouvée identique à Cel
        'CelA = cellules de références de feuille 4

        If Not (Cel_A Is Nothing) Then		 'si Cel_A existe

'Copie ===================== (Désactiver les lignes inutiles et activer celles désirées selon option choisie)
  'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")
  'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4
  'copier B et C de Cel sur C et D de Cel_A
            
 'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 2)).Copy F_B.Cells(Cel_A.Row, "B")
 'copier B et C de Cel sur C et D de Cel_A
            
'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "c")
'Copie les cellules B de la feuille 3 en D de la feuille 4

'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "c")
'Copie les cellules B de la feuille 4 en C de la feuille 3

'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "e")
'Copie les cellules C de la feuille 4 en E de la feuille 3

F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C") ‘Cible active
'Copie les cellules F de la feuille 4 en C de la feuille 3 
‘(F=4 : Colonne de référence (colonne B) + différence pour aller à colonne F à copier)

'F_B.Range(Cel_A.Offset(0, 9), Cel_A.Offset(0, 6)).Copy F_A.Cells(Cel.Row, "C")
'Copie les cellules H, I, J, K de la feuille 4 en C, D, E, F de la feuille 3  

        End If
    End If
Next Cel    'Cellule suivante
End Sub

J'ai essayé aussi ça : (ça ne fonctionne pas non plus.)

Sub A1_inventaire_9_Boites_Dialogue() ' Ne fonctionne pas, (en cours de modifs)
'-compare la cellule "A2" de la colonne "A" feuille "Essai" classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille "Recapitulatif" du classeur "1Emplacement"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille Essai du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne "J" de la feuille "Recapitulatif" du classeur "1Emplacement" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
    'Travail sur 2 feuilles dans 2 classeurs différents)

'Définition =======================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet
Dim Fi1 As String, Fi2 As String, F1 As String, F2 As String, C1 As String, C2 As String, D As String, A As String

'Chemin ==============================
Fi1 = InputBox("Nom du fichier 1" & ".xls", "Nom") 'Semble fonctionner
Fi2 = InputBox("Nom du fichier 2" & ".xls", "Nom") 'Semble fonctionner
F1 = InputBox("Nom de la feuille 1", "Feuil") 'Semble fonctionner
F2 = InputBox("Nom de la feuille 2", "Feuil") 'Semble fonctionner

C1 = InputBox("Colonne de référence 1", "Colonne") 'A tester
C2 = InputBox("Colonne de référence 2", "Colonne") 'A tester
D = InputBox("Colonne de Départ de copie)", "Depart") 'A tester
A = InputBox("Colonne d' arrivée (collage)", "Arrivee") 'A tester

'Set F_A = Workbooks("Inventaire-Essai.xls").Sheets("essai") 'Fonctionne
'Set F_B = Workbooks("1Emplacement.xls").Sheets("Recapitulatif") 'Fonctionne
        'ou
Set F_A = Workbooks(Fi1).Sheet(F1) 'Ne fonctionne pas : l'indice n'appartient pas à la sélection.
Set F_B = Workbooks(Fi2).Sheet(F2) 'Ne fonctionne pas : l'indice n'appartient pas à la sélection.

'Traitement =======================
'    For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp))
For Each Cel In F_A.Range(F_A.C1, F_A.Range(C1 & Rows.Count).End(xlUp))     'Erreur compilation
                'Pour chaque cellule de A   'Cel = cellules de références de feuille 3

    If Not (IsEmpty(Cel)) Then
    'si Cel n'est pas vide
   
   Set Cel_A = F_B.C2.Find(Cel)    'Erreur compilation
 '     Set Cel_A = F_B.Columns(C1).Find(Cel)    'Columns(2)= colonne B
        'fixer Cel_a en tant cellule trouvée identique à Cel
        'CelA = cellules de références de feuille 4

                    If Not (Cel_A Is Nothing) Then
                    'si Cel_A existe

            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")
            'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4
            'copier B et C de Cel sur C et D de Cel_A
            
            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 2)).Copy F_B.Cells(Cel_A.Row, "B")
            'copier B et C de Cel sur C et D de Cel_A
            
            'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "e")
            'Copie les cellules C de la feuille 4 en E de la feuille 3

'F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")
'Copie les cellules F de la feuille 4 en C de la feuille 3
'(J=9 : Colonne de référence + différence pour colonne à copier)

        F_B.Range(C2.D, C2.D).Copy F_A.Cells(Cel.Row, A)  'A tester
        'Copie les cellules F de la feuille 4 en C de la feuille 3
        '(J=9 : Colonne de référence + différence pour colonne à copier)
        End If
    End If
Next Cel    'Cel suivante
End Sub

 

[Toine45]

Re : Comparer 2 feuilles et copier une cellule de feuille 2 à feuille1, si égalité de

Bonjour
Je cherche à définir le chemin d'un fichier (variable) dans une macro, par l'intermédiaire d'une boîte de dialogue
pourriez-vous m'aider, svp ça fait un mois que je rame et je tourne en rond. (Voir fichier joint (Classeur2), j'ai fait plusieurs essais.