Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating mulitple workbooks from single workbook - *Macro tweaking needed*
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating mulitple workbooks from single workbook - *Macro tweakingneeded*
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Creating mulitple workbooks from single workbook - *Macro tweaking needed*
On Feb 15, 3:31 pm, Dave Peterson 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can mulitple Excel workbooks be summarized into 1 workbook? | Excel Discussion (Misc queries) | |||
merge columns into single report - macro needed | Excel Discussion (Misc queries) | |||
Creating a single workbook from multiple workbooks | Excel Discussion (Misc queries) | |||
Creating multiple workbooks from summary workbook | Excel Discussion (Misc queries) | |||
creating new workbook from single worksheet | Excel Programming |