Sub SheetExport()
Dim Monat As String
Dim Jahr As String
Dim Reitername As String
Dim LetzteZeile As Long
Dim i As Long
Const Pfad As String = "M:\Abteilung Marketing\SoFi\02 PROMOTIONPAKETE\"
Monat = Worksheets("Admin").Range("B1").Value
Jahr = Worksheets("Admin").Range("B2").Value
LetzteZeile = Worksheets("Admin").Cells(Rows.Count, 6).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To LetzteZeile
If Worksheets("Admin").Range("G" & i).Value = "x" Then
Reitername = Worksheets("Admin").Range("F" & i).Value
Sheets(Reitername).Copy
Sheets(Reitername).Activate
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Delete
ActiveWorkbook.SaveAs Filename:=Pfad & Jahr & "\" & Monat & "\" & Reitername & "_" & Monat & "_" & Jahr & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close False
End If
Next i
Application.ScreenUpdating = True
End Sub