Hallo,

habe mir Deinen Code jetzt nicht näher angesehen und verstanden, aber hier eine Idee zu Deinem Problem.

Wenn die Mappe nicht auf ist, wird bei dem besagten Befehl ein Fehler erzeugt, den kann man zwar abfangen,aber m.E. ist der Befehl da fehl am Platz.

Weiter unten fragst Du ja ab, ob die Mappe auf ist und wenn sie auf ist, kannst Du dort gefahrlos den Befehl einsetzen, wobei Du die Mappe dann auch gleich ohne Setzung der Variablen schließen könntest..

Sub Testseparieren()
 
' DIM
Dim QWB As Workbook      ' Quellworkbook Suchmeldungen
Dim ZWB As Workbook      ' Zielworkbook Meldungen
Dim SMPfad As String   ' Pfad zum Quellworkbook
 
    SMPfad = ("C:\Test\Blacklist Test.xlsx")
'Set QWB = Workbooks("Blacklist Test")              '<<<<hier weg>>>>>

' Zum Beschleunigen Ausschalten
Application.ScreenUpdating = True
Application.EnableEvents = True
' Caculation auf Zustand pr?fen und ausschalten. Bei Fehler in alten Zustand zur?cksetzen
Dim oldCalculation As Long
    oldCalculation = Application.Calculation
    On Error GoTo Fehler
    Application.Calculation = xlCalculationManual
'Name des Sheets ?ndern
    ActiveSheet.Name = "Original"
   
SSe:   'Suchmeldungen Sheet einf?gen

    ' Sheet Blacklist in Sheet einf?gen
 Set ZWB = ActiveWorkbook
 
 
' Kontrolle ob Datei Blacklist f?r FIS Meldungen schon offen

If IsWorkbookOpen("Blacklist Test") Then
    Set QWB = Workbooks("Blacklist Test")               '<<<<hier hin>>>>
    If MsgBox("Blacklist Test schlie?en?", vbYesNo) = vbYes Then
        QWB.Close False        ' Schlie?en der Suchmeldungen
        Set QWB = Nothing
        Else
        GoTo Fehler
    End If
   Else
      MsgBox "Nicht offen"
End If
 
  Stop
 
' ?ffnen des Pfades und Kopieren aller Sheets in aktives Workbook

Dim lngCounter As Long
Set QWB = Workbooks.Open(SMPfad)
For lngCounter = 1 To QWB.Sheets.Count
    QWB.Sheets(lngCounter).Copy After:=ZWB.Sheets(ZWB.Sheets.Count)
Next lngCounter
Set ZWB = Nothing
Set QWB = Nothing
 
 
Stop

'Nur wenn oben nicht funktioniert, einzele Sheets kopieren
 
Set QWB = Workbooks.Open(SMPfad)
   QWB.Worksheets("Blacklist").Cells.Copy

With ZWB
    .Sheets.Add After:=.ActiveSheet
    .ActiveSheet.Name = "Blacklist"
    .ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    Application.CutCopyMode = False
End With
QWB.Close False        ' Schlie?en der Blacklist
Set QWB = Nothing

Fehler:
End Sub

viele Grüße

Karl-Heinz