Excel vba Suche nach Fehlerquelle

[sharky51]

Hallo zusammen,

darf ich Euch mal wieder um Euren Rat bitten?

Ein Makro, das bislang funktioniert hatte, verweigert plötzlich seinen Dienst.
Die Aufgabe des Makros ist aus seiner eigenen Arbeitsmappe heraus ein Tabellenblatt aus einer anderen Mappe zu kopieren.
Das hat bisher auch perfekt funktioniert. Es wurden auch keine Namensänderungen der Quell- oder Zieldatei vorgenommen und die Dateien befinden sich am gleichen Speicherort wie bisher.

Vielleicht könnt Ihr mir einen Tipp geben, woran es liegen könnte, dass das Makro mit dieser Fehlermeldung stoppt?
"Laufzeitfehler 9: Index außerhalb des gültigen Bereichs"

Hier das Makro:

Code:

Public Sub MainCopy()
  Dim wksSheet As Worksheet
  Dim objFile As Object
 
  iPath = "D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Sellin\2020 Auswertungen\"
  strSourceFile = "SunTec_Monitoring_AKT.xlsm"
 
  On Error GoTo Fin
 
  Set objFile = GetObject(iPath & strSourceFile)
 
  For Each wksSheet In objFile.Worksheets
      If wksSheet.Tab.ColorIndex = 43 Then
        If Not fncSheetExist(ThisWorkbook.Name, wksSheet.Name) Then
            wksSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            strTeilName = ActiveSheet.Name
            numSheet = Mid(strTeilName, 4, 2)
            If Left(numSheet, 1) = 0 Then
              numSheet = Mid(strTeilName, 5, 1)
            Else
              cName = ActiveSheet.CodeName
              ThisWorkbook.VBProject.VBComponents(cName).Properties(5).Value = "Tabelle" & numSheet
            End If
        End If
      End If
  Next wksSheet
Fin:
 
  Call Create_Hyperlink_Table_of_Contents
End Sub


Das Makro bricht bei " fncSheetExist" ab, obwohl wkbTemp und strName die richtigen Werte, sprich Dateinamen und Blattnamen enthält.

Private Function fncSheetExist(ByVal wkbTemp As String, ByVal strName As String) As Boolean
  On Error Resume Next
  fncSheetExist = Not Workbooks(wkbTemp).Worksheets(strName) Is Nothing
  Err.Clear
End Function

Was geht hier schief? Vielleicht könnt Ihr mir helfen?

[schauan]

Hallo Erich,

Vielleicht könnt Ihr mir einen Tipp geben, woran es liegen könnte, dass das Makro mit dieser Fehlermeldung stoppt?
"Laufzeitfehler 9: Index außerhalb des gültigen Bereichs"

in welcher Zeile? Prüfe die Bestandteile der Zeile, z.B. den Inhalt von Variablen, Blattnamen usw.

[sharky51]

Hallo André,

danke für die Rückmeldung.

Die Fehlermeldung kommt an dieser Stelle der Function:

Code:

fncSheetExist = Not Workbooks(wkbTemp).Worksheets(strName) Is Nothing

Die Variablen habe ich geprüft. wkbTemp und strName haben die richtige Werte.

[schauan]

Hallöchen,

da sollte durch Dein On Error ... eigentlich kein Fehler 9 kommen ...

[sharky51]

Auch Hallo,

ich verstehe es ja auch nicht....es hat ja bislang bestens funktioniert.

Kann es sein, dass mit den Verweisen etwas nicht stimmt?

[Kuwer]

Hallo Erich,

hast vielleicht zu viel aus dem Code gelöscht. Im Fin:-Abschnitt stand hier mehr drin.

Gruß Uwe

[schauan]

Hallöchen,

DU kannst das mit dem Laufzeitfehler auch ganz einfach ausprobieren.

Sub Test
On Error Resume Next
Msgbox Workbooks("AAA").Worksheets("BBB").Name
Err.Clear
End Sub

Nimmst Du On Error ... weg, dann kommt der Fehler 9, sonst nicht.

[sharky51]

Guten Morgen André,

Deinen Vorschlag hatte ich auch schon probiert, bringt aber keine Abhilfe.

Egal ob ich "On Error Resume Next" wegnehme oder aktiv lasse, es kommt immer die gleiche Fehlermeldung:
"Laufzeitfehler 9: Index außerhalb des gültigen Bereichs"

Ist schon seltsam das Ganze!

[sharky51]

Guten Morgen André,

Deinen Vorschlag hatte ich auch schon probiert, bringt aber keine Abhilfe.

Egal ob ich "On Error Resume Next" wegnehme oder aktiv lasse, es kommt immer die gleiche Fehlermeldung:
"Laufzeitfehler 9: Index außerhalb des gültigen Bereichs"

Ist schon seltsam das Ganze!

Ergänzung:
Habe das Ganze nochmals neu aufgesetzt und hiermit versucht:

Code:

Option Explicit

Sub Kopieren_Auswertung()
    Dim sPfad As String
    Dim sName As String

    sPfad = ThisWorkbook.Path
    sName = "D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Sellin\2020 Auswertungen\SunTec_Monitoring_Oktober_2020.xlsm\"
        If sName <> ThisWorkbook.Name Then
            ThisWorkbook.Worksheets("SunTec_Monitoring_AKT.xlsm").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
        End If
End Sub
 

Bekomme nach wie vor dieselbe Fehlermeldung!?

[schauan]

Hallo Erich,
Also, wenn Du eine neue Datei nimmst und meinen Beispielcode dort rein tust und ausführst kommt trotzdem der Fehler 9?