hier wird der Name vergeben. .Name = i - 1 & " - " & i - 2 + TEILER gut zu erkennen an .Name =
versuchs mal damit.
Sub verteilen()
Dim sh As Worksheet
Dim i&, maxrow&, rng As Range
Dim praefix$
Const TEILER = 50000
praefix = Application.InputBox("Vorsilbe eingeben", "Eingabe", Type:=2)
If praefix = "" Or praefix = "Falsch" Then
MsgBox "Keine Vorsilbe für Dateinamen ausgewählt", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
Set sh = ActiveSheet
Set rng = Intersect(sh.UsedRange, sh.Rows(1))
maxrow = sh.UsedRange.Rows.Count
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To maxrow
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = praefix & i - 1 & " - " & i - 2 + TEILER
rng.Copy .Cells(1, 1)
sh.Cells(i, 1).Resize(TEILER, rng.Columns.Count).Copy .Cells(2, 1)
Application.CutCopyMode = False
.Copy
ActiveWorkbook.SaveAs Filename:=.Parent.Path & "\" & .Name
ActiveWorkbook.Close
i = i + TEILER - 1
.parent.Activate
If i > maxrow Then Exit Sub
End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
|