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
|