I found this macro in the forums and it works great. What is does is
create a seperate CSV file for every row in the workbook.

What I would like to do though is create a file for every 25 rows. I
also would like to make the files .XLS, not .CSV.

Can anyone assist in tweaking this macro for me? Thanks!

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet


Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long


Set curWks = Worksheets("sheet1")
Set newWks = Workbooks.Add(1).Worksheets(1)


With curWks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row


.Rows(1).Copy
With newWks.Range("A1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With


For iRow = FirstRow To LastRow
.Rows(iRow).Copy
With newWks.Range("a2")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
newWks.Parent.SaveAs _
Filename:="C:\temp\" & Format(iRow, "0000") & ".csv", _
FileFormat:=xlCSV
Next iRow
End With


newWks.Parent.Close savechanges:=False


End Sub

Still keep the first row as a header row?

(Untested, but it did compile)

Option Explicit
Sub testme()

Dim curWks As Worksheet
Dim newWks As Worksheet

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myStep As Long

Set curWks = Worksheets("sheet1")
Set newWks = Workbooks.Add(1).Worksheets(1)

myStep = 25

With curWks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

.Rows(1).Copy
With newWks.Range("A1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With

For iRow = FirstRow To LastRow Step myStep
.Rows(iRow).Resize(myStep).Copy
With newWks.Range("a2")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
newWks.Parent.SaveAs _
Filename:="C:\temp\" & Format(iRow, "0000") & ".xls", _
FileFormat:=xlWorkbookNormal
Next iRow
End With

newWks.Parent.Close savechanges:=False

End Sub


Dan wrote:
>
> I found this macro in the forums and it works great. What is does is
> create a seperate CSV file for every row in the workbook.
>
> What I would like to do though is create a file for every 25 rows. I
> also would like to make the files .XLS, not .CSV.
>
> Can anyone assist in tweaking this macro for me? Thanks!
>
> Option Explicit
> Sub testme()
>
> Dim curWks As Worksheet
> Dim newWks As Worksheet
>
> Dim iRow As Long
> Dim FirstRow As Long
> Dim LastRow As Long
>
> Set curWks = Worksheets("sheet1")
> Set newWks = Workbooks.Add(1).Worksheets(1)
>
> With curWks
> FirstRow = 2 'headers in row 1
> LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
>
> .Rows(1).Copy
> With newWks.Range("A1")
> .PasteSpecial Paste:=xlPasteValues
> .PasteSpecial Paste:=xlPasteFormats
> End With
>
> For iRow = FirstRow To LastRow
> .Rows(iRow).Copy
> With newWks.Range("a2")
> .PasteSpecial Paste:=xlPasteValues
> .PasteSpecial Paste:=xlPasteFormats
> End With
> newWks.Parent.SaveAs _
> Filename:="C:\temp\" & Format(iRow, "0000") & ".csv", _
> FileFormat:=xlCSV
> Next iRow
> End With
>
> newWks.Parent.Close savechanges:=False
>
> End Sub

--

Dave Peterson

On Feb 15, 3:31 pm, Dave Peterson <peter...@verizonXSPAM.net> wrote:
> Still keep the first row as a header row?
>
> (Untested, but it did compile)
>
> Option Explicit
> Sub testme()
>
> Dim curWks As Worksheet
> Dim newWks As Worksheet
>
> Dim iRow As Long
> Dim FirstRow As Long
> Dim LastRow As Long
> Dim myStep As Long
>
> Set curWks = Worksheets("sheet1")
> Set newWks = Workbooks.Add(1).Worksheets(1)
>
> myStep = 25
>
> With curWks
> FirstRow = 2 'headers in row 1
> LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
>
> .Rows(1).Copy
> With newWks.Range("A1")
> .PasteSpecial Paste:=xlPasteValues
> .PasteSpecial Paste:=xlPasteFormats
> End With
>
> For iRow = FirstRow To LastRow Step myStep
> .Rows(iRow).Resize(myStep).Copy
> With newWks.Range("a2")
> .PasteSpecial Paste:=xlPasteValues
> .PasteSpecial Paste:=xlPasteFormats
> End With
> newWks.Parent.SaveAs _
> Filename:="C:\temp\" & Format(iRow, "0000") & ".xls", _
> FileFormat:=xlWorkbookNormal
> Next iRow
> End With
>
> newWks.Parent.Close savechanges:=False
>
> End Sub
>
>
>
>
>
> Dan wrote:
>
> > I found this macro in the forums and it works great. What is does is
> > create a seperate CSV file for every row in the workbook.
>
> > What I would like to do though is create a file for every 25 rows. I
> > also would like to make the files .XLS, not .CSV.
>
> > Can anyone assist in tweaking this macro for me? Thanks!
>
> > Option Explicit
> > Sub testme()
>
> > Dim curWks As Worksheet
> > Dim newWks As Worksheet
>
> > Dim iRow As Long
> > Dim FirstRow As Long
> > Dim LastRow As Long
>
> > Set curWks = Worksheets("sheet1")
> > Set newWks = Workbooks.Add(1).Worksheets(1)
>
> > With curWks
> > FirstRow = 2 'headers in row 1
> > LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
>
> > .Rows(1).Copy
> > With newWks.Range("A1")
> > .PasteSpecial Paste:=xlPasteValues
> > .PasteSpecial Paste:=xlPasteFormats
> > End With
>
> > For iRow = FirstRow To LastRow
> > .Rows(iRow).Copy
> > With newWks.Range("a2")
> > .PasteSpecial Paste:=xlPasteValues
> > .PasteSpecial Paste:=xlPasteFormats
> > End With
> > newWks.Parent.SaveAs _
> > Filename:="C:\temp\" & Format(iRow, "0000") & ".csv", _
> > FileFormat:=xlCSV
> > Next iRow
> > End With
>
> > newWks.Parent.Close savechanges:=False
>
> > End Sub
>
> --
>
> Dave Peterson- Hide quoted text -
>
> - Show quoted text -

Perfect! Thanks so much!!
Dan