Hallo alle zusammen

Ich möchte gerne Tabellenblätter von einer Mappe in eine andere Mappe kopieren.
Meine Programmzeile liefert aber einen Fehler:


' Tabelle UserTools kopieren, wenn nicht vorhanden
If wsUserTools Is Nothing Then
On Error Resume Next
wbCurrent.Worksheets("UserTools").Copy _
After:=wbSelected.Sheets(wbSelected.Sheets.Count)
If Err.Number > 0 Then
Debug.Print Err.Number '9
Debug.Print Err.Description 'Index außerhalb des gültigen Bereichs
End If
End If


Im On Error habe ich die Fehlermeldung in den Kommentar geschrieben, damit es besser zu erkennen ist.

Ich verstehe nicht warum der Copy Befehl Index ausserhalb liefert.

Vielen Dank für Hinweise, welche den Index in den gültigen Bereich bringt.



Der gesamte code ist:

Sub OpenFileAndCopySheets()
Dim fd As FileDialog
Dim selectedFile As String
Dim wbSelected As Workbook
Dim wbCurrent As Workbook
Dim wsUserTools As Worksheet
Dim wsAdminTools As Worksheet
Dim wsUserWas As Worksheet
Dim sheetExists As Boolean

' Aktuelle Arbeitsmappe speichern
Set wbCurrent = ThisWorkbook

' Dateiauswahl-Dialog öffnen
Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
.Title = "Wählen Sie eine Excel-Datei aus"
.Filters.Clear
.Filters.Add "Excel-Dateien", "*.xlsx; *.xls; *.xlsm"
.AllowMultiSelect = False

If .Show > -1 Then Exit Sub ' Abbrechen, wenn keine Datei ausgewählt

selectedFile = .SelectedItems(1)
End With

' Ausgewählte Datei öffnen
Set wbSelected = Workbooks.Open(selectedFile)

' Überprüfen, ob die Tabellen existieren und ggf. kopieren
On Error Resume Next ' Fehler ignorieren, falls das Blatt nicht existiert
Set wsUserTools = wbSelected.Worksheets("UserTools")
Set wsAdminTools = wbSelected.Worksheets("AdminTools")
On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren

' UserTools kopieren, wenn nicht vorhanden
If wsUserTools Is Nothing Then
On Error Resume Next
wbCurrent.Worksheets("UserTools").Copy _
After:=wbSelected.Sheets(wbSelected.Sheets.Count)
If Err.Number > 0 Then
Debug.Print Err.Number '9
Debug.Print Err.Description 'Index außerhalb des gültigen Bereichs
End If
End If

' AdminTools kopieren, wenn nicht vorhanden
If wsAdminTools Is Nothing Then
'L$uft durch aber kopiert nicht weil es die tbl nicht gibt-
wbCurrent.Worksheets("AdminTools").Copy After:=wbSelected.Sheets(wbSelected.Sheets.Count)
End If

' UserWas kopieren, wenn nicht vorhanden
If wsUserWas Is Nothing Then
'Fehlermeldung 9 Index ausserhalb des gültigen Bereich
wbCurrent.Worksheets("AdminTools").Copy After:=wbSelected.Sheets(wbSelected.Sheets.Count)
End If

' Bestätigung ausgeben
MsgBox "Die erforderlichen Tabellen wurden geprüft und ggf. kopiert.", vbInformation, "Fertig"

End Sub