Hallo Zusammen,
ich bin mal wieder auf der Suche nach einer Lösung. Ich habe im Internet recherchiert, aber nichts brauchbares gefunden. Da meine Kenntnisse auch nicht allzu tief sind, benötige ich eure Hilfe.
Ich habe nachfolgenden Code der mit aus den Datei WBQuelle das Tabellenblatt "Übersicht" korrekt in die Ziel Datei übernimmt. Nun möchte ich aber zusätzlich, dass alle Tabellenblätter ab dem 7. Tabellenblatt, falls in der Ziel Datei noch nicht vorhanden, ebenfalls kopiert wird.
Ich habe zwar aus einem anderen Makro versucht, die Passage hier einzufügen... bekomme das aber nicht gebacken (siehe ganz unten *****).
Ich hoffe, jemand kann mir hier helfen.
Besten Dank
Günther
PS: Kann sein, ich melde mich erst Anfang nächster Woche, also nicht böse sein.
Sub DatenHolen()
Dim ExportDatei As Variant
Dim WBQuelle As Workbook, WBZiel As Workbook
Dim lngCalc As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = -4135
.DisplayAlerts = False
End With
Set WBZiel = ThisWorkbook
'DateiÖffnen Dialog anbieten
ExportDatei = Application.GetOpenFilename("Micrsoft Excel-Dateien (*.xlsm),*.xlsm", , "Bitte die Datei xyz.xls öffnen ...")
If ExportDatei CStr(False) Then
'öffnen der ausgewählten Datei
Set WBQuelle = Workbooks.Open(ExportDatei)
With WBZiel
WBQuelle.Sheets(Array("Übersicht")).Copy After:=.Sheets(.Sheets.Count)
'Hier sollen also alle neuen Tabellenblätter ab Tab 7 ebenfalls kopiert werden
End With
WBQuelle.Close False
Set WBZiel = Nothing
Set WBQuelle = Nothing
ErrExit:
With Err
If .Number 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'DatenHolen'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - DatenHolen"
.Clear
End If
End With

**************
Ich komm hier nicht klar um den richtigen Code oben einzufügen
Dim lwbTarget As Workbook
Dim liThis As Integer, lshTarget As Worksheet, lboExist As Boolean
Dim wbkQuelle As Workbook
Dim wbkZiel As Workbook
Dim wksQuelle As Worksheet
Set wbkQuelle = Workbooks.Open(ExportDatei)
Set wbkZiel = Workbooks("Version_2.xlsm")
Set wksQuelle = wbkQuelle.Worksheets("Links")
Set lwbTarget = Workbooks("Version_2.xlsm") 'wenn deine geöffnete Zieldatei anders heißt, dann hier anpassen
With ThisWorkbook
For liThis = 7 To .Sheets.Count 'ab Tabellenblatt 7
For Each lshTarget In lwbTarget.Sheets
If .Sheets(liThis).Name = lshTarget.Name Then
lboExist = True
Exit For
End If
Next
If lboExist = True Then
lboExist = False
Else
.Sheets(liThis).Copy After:=lwbTarget.Sheets(lwbTarget.Sheets.Count)
End If
Next
End With
******************************************