Sub Compiler_XMLs()
Dim wb_A As Workbook, WBKS As Workbook, strPath$, fXML$, i&
On Error GoTo ErrHandler
With Application.FileDialog(4)
.AllowMultiSelect = 0: .Title = "Choisir le répertoire XML"
If .Show = -1 Then strPath = .SelectedItems(1)
End With
If strPath = "" Then Exit Sub
Application.ScreenUpdating = False
Set wb_A = ThisWorkbook: i = 1
fXML = Dir(strPath & "\*.xml")
Do While fXML <> vbNullString
Set WBKS = Workbooks.OpenXML(strPath & "\" & fXML)
WBKS.Sheets(1).UsedRange.Copy wb_A.Sheets(1).Cells(i, 1)
WBKS.Close False
i = wb_A.Sheets(1).UsedRange.Rows.Count + 2
fXML = Dir()
Loop
Application.ScreenUpdating = True
wb_A.Save
Exit Sub
ErrHandler:
MsgBox "Aucun fichier XML!", vbCritical, "Erreur"
End Sub