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 = Sheets("Admin").Range("B1").Value
Jahr = Sheets("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
ActiveWorkbook.SaveAs Pfad & Jahr & "\" & Monat & "\" & Reitername, FileFormat:=ThisWorkbook.FileFormat
ActiveWorkbook.Close False
End If
Next i
Application.ScreenUpdating = True
End Sub