Sub Import_ein_blatt()
Dim Dialog As FileDialog
Dim vrtSelectedItem As Variant
Dim lngNaechsteZeile As Long
Dim strZielBlatt As String
Dim rngZielBereich As Excel.Range
Dim WS As Excel.Worksheet
Dim lngXMLLaufzahl As Long
On Error Resume Next
Set Dialog = Application.FileDialog(msoFileDialogOpen)
With Dialog
.AllowMultiSelect = True
.Title = "Bitte gewünschte Daten auswählen"
.ButtonName = "Importieren"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
End If
strZielBlatt = "Tabelle1"
Set WS = Sheets(strZielBlatt)
If Err.Number <> 0 Then
Err.Clear
Set WS = Sheets.Add(, Sheets(Sheets.Count))
WS.Name = "Tabelle1"
End If
lngNaechsteZeile = 6
lngXMLLaufzahl = 1
For Each vrtSelectedItem In .SelectedItems
Set rngZielBereich = WS.Range("$A$" & CStr(lngNaechsteZeile))
With ActiveWorkbook.XmlMaps(lngXMLLaufzahl)
.ShowImportExportValidationErrors = False
.AdjustColumnWidth = True
.PreserveColumnFilter = False
.PreserveNumberFormatting = True
.AppendOnImport = False
End With
ActiveWorkbook.XmlImport URL:=vrtSelectedItem, ImportMap:=Nothing, Overwrite:=False, Destination:=rngZielBereich
Set rngZielBereich = Nothing
lngNaechsteZeile = WS.Cells(WS.Cells.Rows.Count, 1).End(xlUp).Row + 1
lngXMLLaufzahl = lngXMLLaufzahl + 1
Next
End With
Set WS = Nothing
End Sub