Excel-Tabellenblätter importieren VBA
05.10.2018 09:43:10
Hendrik
ich komme leider mit meinem Halbwissen wieder nicht weiter.
Der unten stehende Code soll, was er auch tut, ein Tabellenblatt aus einer anderen Datei einfügen. Funktioniert wunderbar.
Nun aber mein Problem: Da ich viele Dateien einfügen muss, möchte ich nicht jede Datei einzeln auswählen müssen mit GetopenFile. Der Mutliselect = True funktionert nicht.
Gibt es denn eine andere Möglichkeit die Dateien auf einmal einzufügen und nicht einzeln ?
Vielen Dank vorab!
VG
Hendrik
Sub Datenholen()
Dim ExportDatei As Variant
Dim WBQuelle As Workbook, WBZiel As Workbook
Dim lngCalc As Long
Dim nummer As Variant
Dim Anzahl As Variant
Application.ScreenUpdating = True
With Application
.ScreenUpdating = False
.EnableEvents = True
.DisplayAlerts = True
.StatusBar = True
'Nummer = ThisWorkbook.Sheets("Tabelle1").Range("AK2").Value
For i = 1 To 12
On Error GoTo ErrExit
Set WBZiel = ThisWorkbook
'DateiÖffnen Dialog anbieten
ChDrive "C:\"
ChDir "C:\Mails\MEGA"
ExportDatei = Application.GetOpenFilename("Micrsoft Excel-Dateien (*.xlsx*),*.xlsx*", , " _
Bitte auswählen ...", MultiSelect:=False)
If ExportDatei = False Then Exit Sub
If ExportDatei CStr(False) Then
'öffnen der ausgewählten Datei
Set WBQuelle = Workbooks.Open(ExportDatei)
With WBZiel
WBQuelle.Sheets("Table 1").Copy after:=.Sheets(.Sheets.Count)
End With
WBQuelle.Close False
Set WBZiel = Nothing
Set WBQuelle = Nothing
ErrExit:
With Err
If .Number 0 Then
MsgBox "Fehler." & Chr(13) & Chr(13) & "Bitte schließen."
End If
End With
End If
On Error GoTo 0
With Application
.StatusBar = False
End With
Next
MsgBox "wurden akzeptiert."
End With
Application.ScreenUpdating = True
End Sub