Hallo Zusammen,

ich möchte eine große Vorlagedatei für verschiedene Benutzer anpassen und in verschiedenen Varianten abspeichern.
Die Benutzer benötigen alle eine andere Konstellation von Spalten. Diese habe ich in einer Matrix vorgegeben.

Problem: Ich habe eine Schleife gemacht, in der die geöffnete Vorlagedatei auf den ersten Nutzer angepasst wird. Dann soll sich diese neue Datei speichern und schließen und wieder die Vorlagedatei öffnen um nun die Version für Nutzer 2 zu erzeuegn usw.
Leider klappt das nur für Nutzer 1. Die Schleife macht keinen 2. Durchlauf.

Sub Alle_erzeugen()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim Selektion, Name, Pfad, Überschrift As String
Dim letzteSp, letzteZ, x, y, SpalteMitÜberschrift, AnzOrgs As Integer


With ThisWorkbook.Worksheets("Matrix")
    AnzOrgs = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
    letzteZ = .Cells(.Rows.Count, 1).End(xlUp).Row
   letzteSp = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

'#########################################################################################################################################################################################################
' Schleife 1 EK-Orgs

For x = 1 To AnzOrgs
    With ThisWorkbook.Worksheets("Matrix")
        Name = Application.WorksheetFunction.VLookup(.Cells(x + 1, 1), .Range(.Cells(2, 1), .Cells(letzteZ, letzteSp)), letzteSp - 1, False)
        Pfad = Application.WorksheetFunction.VLookup(.Cells(x + 1, 1), .Range(.Cells(2, 1), .Cells(letzteZ, letzteSp)), letzteSp, False)

    
    ThisWorkbook.SaveAs filename:=Pfad & Name, FileFormat:=xlOpenXMLWorkbook
    
'#########################################################################################################################################################################################################
        ' Schleife 2 Spalten der EK-Org
        
        For y = letzteSp - 3 To 2 Step -1
             If Application.WorksheetFunction.VLookup(.Cells(x + 1, 1), .Range(.Cells(2, 1), .Cells(letzteZ, letzteSp)), y, False) = "raus" Then
                 With ThisWorkbook.Worksheets("Matrix")
                          Überschrift = .Cells(1, y)
                 SpalteMitÜberschrift = Application.WorksheetFunction.Match(Überschrift, ThisWorkbook.Worksheets("Master Data Sheet").Range(ThisWorkbook.Worksheets("Master Data Sheet").Cells(10, 1), ThisWorkbook.Worksheets("Master Data Sheet").Cells(10, letzteSp - 4)), False)
                                                                                          
                 ThisWorkbook.Worksheets("Master Data Sheet").Columns(SpalteMitÜberschrift).delete
                 ThisWorkbook.Worksheets("Prüfung").Columns(SpalteMitÜberschrift).delete
                 ThisWorkbook.Worksheets("Prüfung").Rows("1:7").ClearContents
                 End With
             End If
         Next y
         
        'ende Schleife 2
'#########################################################################################################################################################################################################

ThisWorkbook.Worksheets("Master Data Sheet").Shapes.Range(Array("delete_entries")).delete
ThisWorkbook.Worksheets("Master Data Sheet").Shapes.Range(Array("Vollständigkeit")).delete
ThisWorkbook.Worksheets("SDB vom EK_LF").delete
ThisWorkbook.Worksheets("Matrix").delete
ThisWorkbook.Worksheets("Blaetter erzeugen").delete



If x < AnzOrgs Then
  Workbooks.Open filename:="\\gh.de\dfs\gh-zen-FLDREDIR\Ottee\Desktop\Dezember\Master Data Sheet P&C from December_Test.xlsb"
  Workbooks("Master Data Sheet P&C from December_Test.xlsb").Activate
End If
End With

Workbooks(Name).Save
Workbooks(Name).Close

Next x
'ende Schleife 1
'#########################################################################################################################################################################################################
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Was muss ich verändern, damit es klappt?

Vielen Dank im voraus,

MfG

Enrico