Hallo liebe Leute,

ich muss in der Arbeit mal wieder einen älteren VBA-Code anpassen und all meine Versuche sind gescheitert. Der Code zieht sich aus der Ursprungsdatei mehrere Tabs zusammen, erstellt mit denen eine neue Datei und legt die in einem vordefinierten Ordner ab. Dieser Vorgang wird mehrmals manuell gestartet (Jeder Verantwortliche bekommt eine Datei mit für ihn bestimmten Informationen). Sämtliche Tabs mit Grafiken in der Ursprungsdatei (in der das Makro ausgeführt wird) beginnen "G-..." und werden ebenso in die neu erstellte Datei gezogen. Dies gilt es nun zu ändern, da in den neuen Dateien keine Grafiken mehr enthalten sein sollen (sprich: Die If-Funktion im VBA-Code soll keine Tabellenblätter/Tabs mitkopieren, die mit "G-.." beginnen. 

Option Explicit
Public PM As String
Public Kette As String

Sub PM_Extrakt_erstellen()
Dim monat As String
Dim ws As Worksheet
Dim blname As String
Dim oXlLinks As Variant
Dim i As Integer
Dim aktmonat As String


'Datei erstellen

Workbooks.Add

ActiveWorkbook.SaveAs "Speicherpfad"

' relevante Blätter finden und kopieren

Windows("Ursprungsdatei.xlsm").Activate

For Each ws In Worksheets
If Not ws.Tab.Color = 255 Then
    If Not ws.Tab.ThemeColor = xlThemeColorAccent2 Then
        If ws.Cells(6, 2) = Kette Then
        
        blname = ws.Name
                 
       
        Workbooks("Ursprungsdatei.xlsm").Worksheets("G-" & blname).Copy Before:=Workbooks("XYZ-" & PM & ".xlsx").Sheets(1)
        ws.Copy Before:=Workbooks("XYZ-" & PM & ".xlsx").Sheets("G-" & blname)
        
        
      End If
    End If
End If

Next ws

' Links löschen

Workbooks("XYZ-" & PM & ".xlsx").Activate

For Each ws In Worksheets

ws.Range("A1").Hyperlinks.Delete
ws.Range("A1").Font.Size = 12
ws.Range("A1").Font.Bold = True

With ws.Range("B6").Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween

End With

With ws.Range("I3").Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween

End With

' Grau färben

With ws.Tab
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
End With
    
Next ws

' Überflüssige Tabellen löschen

Workbooks("XYZ-" & PM & ".xlsx").Worksheets("Tabelle1").Delete

'Verknüpfung löschen

 oXlLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
 
    For i = 1 To UBound(oXlLinks)
       ActiveWorkbook.BreakLink Name:=oXlLinks(i), _
       Type:=xlLinkTypeExcelLinks
    Next i
    


ActiveWorkbook.Save


Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Meine Gedanken waren bisher, dass man in der If-Funktion dem VBA-Code sagt, dass er nicht die Tabs mit "G-.." kopieren soll oder dass diese Tabs im nachhinein wieder aus der neu erstellten Datei gelöscht werden.

Über Vorschläge euererseits würde ich mich sehr freuen :) Ich verzweifle bald am Code.

Liebe Grüße