AW: x Blankodateien generieren und abspeichern
01.09.2009 16:50:03
Original
Hi,
Vorausgesetzt in A1 steht der Pfad einschließlich abschließenden Backslash und die Dateinamen
in den Zellen ab A2 lückenlos einschließlich Extension(z.B. Mappe1.xls) und die Dateinamen
sind Unikate, dann so:
Sub Blanko()
Dim z As Long, lz As Long, rc As Long, Wb As Workbook
rc = Rows.Count
lz = IIf(Cells(rc, 1) "", rc, Cells(rc, 1).End(-4162).Row)
Application.ScreenUpdating = 0
For z = 2 To lz
Set Wb = Workbooks.Add
Wb.SaveAs Tabelle1.[a1].Text & Tabelle1.Cells(z, 1).Text
Wb.Close
Set Wb = Nothing
Next
Application.ScreenUpdating = -1
End Sub
Ohne Fehlerprüfung, ob die Datei bereits im angegebenen Verzeichnis vorkommt.
mfg Kurt