Sub Fusion()
Dim critere, feuille, n, fichier, d As Object, i, nomfich$, dat$, a, b, w As Worksheet
critere = Array("Tabledemande", "Tablebp")
feuille = Array("DI", "BP")
ChDir ThisWorkbook.Path
For n = 0 To UBound(feuille)
1 MsgBox "Sélectionnez 2 fichiers dont le nom commence par """ & critere(n) & """"
2 fichier = Application.GetOpenFilename("Fichiers .xlsx (*.xlsx), *.xlsx", MultiSelect:=True)
If IsArray(fichier) Then
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(fichier)
If LCase(fichier(i)) Like "*" & LCase(critere(n)) & "_########*" Then
nomfich = Dir(fichier(i))
dat = Mid(nomfich, Len(critere(n)) + 2, 8)
d(fichier(i)) = dat
End If
Next i
If d.Count <> 2 Then GoTo 1
a = d.keys: b = d.items
If b(0) <> b(1) Then MsgBox "Les 2 fichiers """ & critere(n) & """ doivent avoir la même date...": GoTo 2
Application.ScreenUpdating = False
For i = 0 To 1
Set w = Workbooks.Open(a(i)).Sheets(1)
With ThisWorkbook.Sheets(feuille(n))
If i = 0 Then .Cells.Delete: .Cells(1) = "Date " & dat
w.Range("A1", w.UsedRange).Copy .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1)
.Columns.AutoFit 'ajustement largeurs
End With
w.Parent.Close False
Next i
Application.ScreenUpdating = True
MsgBox "Les 2 fichiers """ & critere(n) & "_" & dat & """ ont été fusionnés" & vbLf & vbLf & "Voyez la feuille """ & feuille(n) & """"
End If
Next n
End Sub