Bonjour,
Je me permets de vous écrire car j'ai un problème à résoudre avec une macro Excel (je ne connais rien en vba). J’ai vu un de vos posts sur le forum que j'ai essayé d'adapter à mon problème, mais cela ne fonctionne pas.
En effet, j'ai deux fichiers EXCEL MonFichier_1 et MonFichier_2. Mon fichier MonFichier_1 est le fichier de référence. Dans ce fichier MonFichier_1 en colonne "K" (colonne de référence), il existe certaines données portant la même dénomination que dans le fichier MonFichier_2 en colonne "K" également. j'aimerais comparer ces deux colonnes, et s'il y a correspondance exacte, copier et coller pour la cellule testée correspondante, les colonnes A,B,C,D,E,F,G,H du fichier MonFichier_1 des cellules de la même ligne que la cellule testée vers le fichier MonFichier_2 sur la même ligne que la cellule testée en colonnes A,B,C,D,E,F,G,H.
En fait le fichier MonFichier_2 contient plus d'éléments que le MonFichier_1, certains éléments sont identiques (portent la même les mêmes dénominations de part et d'autres en colonne "K"). et dans le MonFichier_1 j'ai déjà complété les colonnes A,B,C,D,E,F,G,H. j'aimerais comparer les colonnes "K" des deux fichiers et compléter automatiquement s'il y a correspondance les colonnes A,B,C,D,E,F,G,H du fichier MonFichier_2 (une sorte de mise à jour).
Voici une ébauche du code que j’ai voulu adapter et qui ne fonctionne pas :
Sub Macro1()
Dim Cellule As Variant
Dim MonFichier_1 As Workbook
Dim LastLine As Integer
Dim Tableau1() As Variant
Dim Tableau2() As Variant
Dim I As Integer
' On cherche le numéro de la dernière ligne utilisée dans la colonne K
LastLine = Range("A65536").End(xlUp).Row
' On redimensionne les 2 tableaux de façon dynamique
ReDim Tableau1(LastLine)
' On a besoin de stocker les valeurs de 8 colonnes
ReDim Tableau2(LastLine, 8)
Application.ScreenUpdating = False
' On charge le tableau1 avec les valeurs de la colonne K du MonFichier_2
For I = 1 To LastLine
Tableau1(I) = Range("K" & Trim(Str(I)))
Next I
' On ouvre le fichier MonFichier_1.xls et on lui donne le focus
Workbooks.Open Filename:=ActiveWorkbook.Path & "\MonFichier_1.xls"
Set MonFichier_1 = ActiveWorkbook
MonFichier_1.Activate
' On scanne la colonne K du MonFichier_1 avec les valeurs contenues dans le tableau1
For I = 1 To LastLine
Set Cellule = ActiveSheet.Range("Pointeur"). Find(Tableau1(I), lookat:=xlWhole)
Tableau2(I, 1) = Cellule.Offset(0, -3).Value
Tableau2(I, 2) = Cellule.Offset(0, -4).Value
Tableau2(I, 3) = Cellule.Offset(0, -5).Value
Tableau2(I, 4) = Cellule.Offset(0, -6).Value
Tableau2(I, 5) = Cellule.Offset(0, -7).Value
Tableau2(I, 6) = Cellule.Offset(0, -8).Value
Tableau2(I, 7) = Cellule.Offset(0, -9).Value
Tableau2(I, 8) = Cellule.Offset(0, -10).Value
Next I
'On referme le classeur MonFichier_1.xls dont on n'a plus besoin
MonFichier_1.Close
' On recopie le contenu du tableau dans les colonnes H,G,F,E,D,C,B,A
For I = 1 To LastLine
Range("H" & Trim(Str(I))) = Tableau2(I, 1)
Range("G" & Trim(Str(I))) = Tableau2(I, 2)
Range("F" & Trim(Str(I))) = Tableau2(I, 3)
Range("E" & Trim(Str(I))) = Tableau2(I, 4)
Range("D" & Trim(Str(I))) = Tableau2(I, 5)
Range("C" & Trim(Str(I))) = Tableau2(I, 6)
Range("B" & Trim(Str(I))) = Tableau2(I, 7)
Range("A" & Trim(Str(I))) = Tableau2(I, 8)
Next I
Application.ScreenUpdating = True
End Sub
Un grand Merci d'avance.
Pascal
-----
