|
Hallo liebe Leute
Ich bin gerade dabei mein Makro neu aufzubauen.
Viele Funktionen funktionieren (meist dank euch) und Tante Google.
Jetzt möchte ich das ganze natürlich etwas aufhübschen und die Pfade usw bereits im oberen Teil einbauen und unten anstelle 10 mal den kompletten Pfad einzugeben eine Variable verwenden.
In der jetzigen Funktion möchte ich erst prüfen ob die Datei bereits geöffnet ist, im bedarfsfall schließen, und dann aus der Tabelle alle Sheets in die aktuelle Datei hinter "Original einzufügen.
____________________________________________________________
Function IsWorkbookOpen(strWB As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function
__________________________________________________________
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")
' 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
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
Es geht jetzt um diesen Teil:
Set QWB = Workbooks("Blacklist Test")
Wenn das Workbook geöffnet ist klappt es wunderbar.
Ist es geschlossen, kommt ein Laufzeitfehler 9 Index außerhalb des gültigen Bereich.
An dieser stelle wollte ich doch nur die Variable eintragen und noch keine Prüfung durchführen.
Wie wäre es Richtig und
was mache ich falsch?
Danke das ich bei euch lernen darf.
VG
|