Grrrr....
Donc, depuis le début c'est un problème de chemin d'accès..........
Alors voilà :
Option Explicit
'!!!!!!!!!!! ¤¤¤¤¤¤¤¤¤¤¤¤ A ADAPTER : les noms des fichiers et des feuilles ¤¤¤¤¤¤¤¤¤ !!!!!!!!!!!!!
Const Fichier1 As String = "fichier 1.xlsx" 'ici le fichier de "base"
Const Fichier2 As String = "fichier 2-1.xlsx" 'ici le fichier qui contient la colonne "Allègement"
Const Fichier3 As String = "fichier 3-1.xlsx" 'ici le fichier qui contient les colonnes "Heures Supp"
Const NomFeuil_1 As String = "Feuil1" 'feuille du fichier de base
Const NomFeuil_2 As String = "Feuil1" 'feuille du fichier2
Const NomFeuil_3 As String = "Feuil1" 'feuille du fichier3
Sub Import_Trois_Fichiers()
Dim Wbk_Sourc As Workbook
Dim Tb_In_Fich1(), Tb_In_Fich2(), Tb_In_Fich3(), Tb_Out()
Dim DLig As Long, L As Long, Lig As Long, Col As Integer, T As Single
Dim Chemin As String
'IMPORTANT :
'J'ai estimé que le fichier fichier1 comportait toutes les données
'contenues dans les deux autres fichiers, voire plus encore.
'Si ce n'est pas le cas, il faudrait nous en dire davantage.
T = Timer
Chemin = ThisWorkbook.Path & Application.PathSeparator
Application.ScreenUpdating = False
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ IMPORT FICHIER 1 ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier1)
With Wbk_Sourc
With .Sheets(NomFeuil_1)
DLig = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
Tb_In_Fich1 = .Range("A2:G" & DLig).Value
End With
.Close
End With
Tb_Out = Tb_In_Fich1
ReDim Preserve Tb_Out(1 To UBound(Tb_In_Fich1, 1), 1 To UBound(Tb_In_Fich1, 2) + 7)
Erase Tb_In_Fich1
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ IMPORT FICHIER 2 ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ Colonne "URSAFF Allègement"
Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier2)
With Wbk_Sourc
With .Sheets(NomFeuil_2)
DLig = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
Tb_In_Fich2 = .Range("A2:F" & DLig).Value
End With
.Close
End With
For L = 1 To UBound(Tb_Out, 1)
For Lig = 1 To UBound(Tb_In_Fich2, 1)
'Si les trois premières colonnes sont identiques
If Tb_In_Fich2(Lig, 1) = Tb_Out(L, 1) And Tb_In_Fich2(Lig, 2) = Tb_Out(L, 2) And Tb_In_Fich2(Lig, 3) = Tb_Out(L, 3) Then
Tb_Out(L, 8) = Tb_In_Fich2(Lig, 6): Exit For
End If
Next Lig
Next L
Erase Tb_In_Fich2
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ IMPORT FICHIER 3 ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ Colonnes "Heures Supp"
Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier3)
With Wbk_Sourc
With .Sheets(NomFeuil_3)
DLig = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
Tb_In_Fich3 = .Range("A2:K" & DLig).Value
End With
.Close
End With
For L = 1 To UBound(Tb_Out, 1)
For Lig = 1 To UBound(Tb_In_Fich3, 1)
'Si les trois premières colonnes sont identiques
If Tb_In_Fich3(Lig, 1) = Tb_Out(L, 1) And Tb_In_Fich3(Lig, 2) = Tb_Out(L, 2) And Tb_In_Fich3(Lig, 3) = Tb_Out(L, 3) Then
For Col = 1 To 6
Tb_Out(L, 8 + Col) = Tb_In_Fich3(Lig, 5 + Col)
Next Col
Exit For
End If
Next Lig
Next L
Erase Tb_In_Fich3
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ RESTITUTION DES DONNEES ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Range("A2").Resize(UBound(Tb_Out, 1), UBound(Tb_Out, 2)) = Tb_Out
Application.ScreenUpdating = True
MsgBox "Travail terminé en : " & Timer - T & " secondes."
End Sub
Maintenant que l'on a réussi à passer la première ligne du code, j’attends que tu me donnes le second plantage