Dim FileName As String
Dim wb As Workbook
Dim i As Long
i = 0
Do While i <= 3
FileName = Application.GetSaveAsFilename( _
Title:="Dateiname für #" & i, _
FileFilter:="Excel-Mappe (*.xlsx), *.xlsx", _
InitialFileName:="I:\02_PM_ZAM\Tools\Tools_Einkauf\OutOfStock_Ablage\" & _
"OutOfStock_PG 3" & i & "\OutOfStock laufendes Jahr\Mappe1.xlsx")
If FileName <> False Then
Set wb = ActiveWorkbook
Call wb.Sheets("Werte PG 3" & i).Copy
Call ActiveWorkbook.SaveAs(FileName:=FileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False)
Call ActiveWorkbook.Close(SaveChanges:=False)
Else
Call MsgBox("Dokument #" & i & " wurde beim Speichervorgang übersprungen.", vbExclamation)
End If
i = i + 1
Loop