VBA ausführen wenn Reitername XX enthält
22.09.2020 11:18:35
Lara
aktuell habe ich 2 Makros:
Makro 1 kopiert einen Reiter in eine neue Arbeitsmappe, wenn der Reitername XXX enthält.
Sub Kopieren()
Dim Worksheet, Pfad
Dim wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Pfad = Worksheets("YY").Range("A1")
For Each Worksheet In Worksheets
If Left(Worksheet.name, 4) = "XXX_" Then
Set wb = Workbooks.Add
Worksheet.Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Worksheets(1).Delete
wb.SaveAs Filename:=Pfad & "\" & Worksheet.name
wb.Close saveChanges:=True
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Formatieren()
Dim Zelle As Range, Zaehler As Integer, Wert As Integer
Wert = CInt(Sheets("YY).Range("D4")) 'Anpassen
With ActiveSheet
.Unprotect 'Blattschutz aufheben
.Cells.Locked = True 'alle Zellen im Blatt sperren
For Each Zelle In .Range("F5:Q5")
Zaehler = Zaehler + 1
'Zellen nach Prüfung sperren
If Zaehler Nun möchte ich, dass dieses Makro für alle Reiter ausgeführt wird, die mit "XXX_" beginnen bevor diese Reiter kopiert und in eine neue Arbeitsmappe eingefügt werden.
Das ganze sieht aktuell bei mir so aus.
Sub Kopieren()
Dim Worksheet, Pfad
Dim wb As Workbook
Dim Zelle As Range, Zaehler As Integer, Wert As Integer
Wert = CInt(Sheets("YY).Range("D4")) 'Anpassen
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Pfad = Worksheets("YY").Range("A1")
For Each Worksheet In Worksheets
If Left(Worksheet.name, 4) = "XXX_" Then
With ActiveSheet
.Unprotect 'Blattschutz aufheben
.Cells.Locked = True 'alle Zellen im Blatt sperren
For Each Zelle In .Range("F5:Q5")
Zaehler = Zaehler + 1
'Zellen nach Prüfung sperren
If Zaehler Aber das Formatierungsmakro wird nicht ausgeführt.
Hat eine/r von euch eine Idee, woran es liegen könnte?
Vielen Dank und
Grüße
Lara