R
Ron de Bruin
You can use this example from Dave Peterson that create a csv file for every 25 rows.
It save the files in your temp folder (Start>Run Enter %temp% ) as csv files (you can change that to xls)
Sub testme()
Dim wks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myStep As Long
Dim iCtr As Long
myStep = 25
Set wks = Worksheets("sheet1")
Set newWks = Workbooks.Add(1).Worksheets(1)
iCtr = 0
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = FirstRow To LastRow Step myStep
newWks.Cells.Clear
.Rows(iRow).Resize(myStep).Copy _
Destination:=newWks.Range("a1")
With newWks
Application.DisplayAlerts = False
iCtr = iCtr + 1
.Parent.SaveAs Filename:=Environ("temp") & "\Extracted_" _
& Format(iCtr, "000"), _
FileFormat:=xlCSV
Application.DisplayAlerts = True
End With
Next iRow
End With
newWks.Parent.Close savechanges:=False
End Sub
It save the files in your temp folder (Start>Run Enter %temp% ) as csv files (you can change that to xls)
Sub testme()
Dim wks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myStep As Long
Dim iCtr As Long
myStep = 25
Set wks = Worksheets("sheet1")
Set newWks = Workbooks.Add(1).Worksheets(1)
iCtr = 0
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = FirstRow To LastRow Step myStep
newWks.Cells.Clear
.Rows(iRow).Resize(myStep).Copy _
Destination:=newWks.Range("a1")
With newWks
Application.DisplayAlerts = False
iCtr = iCtr + 1
.Parent.SaveAs Filename:=Environ("temp") & "\Extracted_" _
& Format(iCtr, "000"), _
FileFormat:=xlCSV
Application.DisplayAlerts = True
End With
Next iRow
End With
newWks.Parent.Close savechanges:=False
End Sub