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
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
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
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
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub