Option Explicit
Sub Import()
Dim Dialog As FileDialog
Dim vrtSelectedItem As Variant
Dim lngLaufZahl As Long
Dim strZielBlatt As String
Dim rngZielBereich As Excel.Range
Dim WS As Excel.Worksheet
On Error Resume Next
Set Dialog = Application.FileDialog(msoFileDialogOpen)
With Dialog
.AllowMultiSelect = True
.Title = "Bitte gewünschte Daten auswählen"
.ButtonName = "Importieren"
.Show
lngLaufZahl = .SelectedItems.Count
If lngLaufZahl = 0 Then
Exit Sub
Else
lngLaufZahl = 1
End If
For Each vrtSelectedItem In .SelectedItems
strZielBlatt = "Tabelle" & CStr(lngLaufZahl)
Set WS = Sheets(strZielBlatt)
If Err.Number <> 0 Then
Err.Clear
Set WS = Sheets.Add(, Sheets(Sheets.Count))
WS.Name = "Tabelle" & CStr(lngLaufZahl)
End If
Set rngZielBereich = WS.Range("$A$6")
ActiveWorkbook.XmlImport URL:=vrtSelectedItem, ImportMap:=Nothing, Overwrite:=False, Destination:=rngZielBereich
Set rngZielBereich = Nothing
Set WS = Nothing
lngLaufZahl = lngLaufZahl + 1
Next
End With
End Sub