Private Sub CommandButton1_Click() 'bouton Consolider
Dim a, chemin$, feuil$, ncol%, LO As Boolean, TS$, fichier, f$, h As Variant
a = Array("Fichier1.xlsx", "Fichier2.xlsx", "Fichier3.xlsx") 'fichiers à consolider
chemin = ThisWorkbook.Path & "\" 'à adapter au besoin
feuil = "Feuil1" 'nom des feuilles sources, à adapter
ncol = 4 'nombre de colonnes à copier, à adapter au besoin
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
If ListObjects.Count Then LO = True: TS = ListObjects(1).TableStyle: ListObjects(1).Unlist 'si tableau Excel
Rows("2:" & Rows.Count).Delete 'RAZ
For Each fichier In a
f = "'" & chemin & "[" & fichier & "]" & feuil & "'!"
h = ExecuteExcel4Macro("MATCH(""zzz""," & f & "C1)")
If IsNumeric(h) Then
With Range("A" & Rows.Count).End(xlUp)(2).Resize(h, ncol)
.FormulaArray = "=" & f & "R1C1:R" & h & "C" & ncol
.Value = .Value 'supprime la formule matricielle
.Replace 0, "", xlWhole 'cellules vides
.Rows(1).EntireRow.Delete 'supprime les titres
End With
End If
Next
UsedRange.Sort Columns(1), xlAscending, Header:=xlYes 'tri alphabétique
If LO Then ListObjects.Add(xlSrcRange, [A1].CurrentRegion, , xlYes).Name = "Tableau1": ListObjects(1).TableStyle = TS
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub