SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

**roi** · 08-07-2013, 11:35 AM

Hi,
I have a master file with multiple rows.
I'm using VBA to split the master file into individual files each holding data from a single row (iRow).
When there are no more values in column A (NB: this does not mean that cells are blank as they contain formulas which do not return a TRUE value) the code should exit.
The individuals files are named after their respective cell (row = iRow, column = A)
I'm using the macro below however: it creates all individual files (i.e from irow to lastrow) but instead of stopping when it reaches lastrow it gives me an error message saying SaveAs method of Workbook class failed - so in essence it tries to create another file even though it has reached the end of data in that column.

What am i doing wrong? (I'm not very experienced in VBA so apologies if my mistake is blatantly obvious!)

Many Thanks
Roi

Sub splitfile()

Dim curWks As Worksheet
Dim newWks As Worksheet

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

Set curWks = Worksheets("Return Format")
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:=ThisWorkbook.Path & "\" & .Cells(iRow, "A").Value & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Next iRow

End With

newWks.Parent.Close savechanges:=False

End Sub

**xladept** · 08-07-2013, 02:45 PM

Hi Roi,

The index always increments - so it will be 1 more than you want it to be after the loop:

Sub splitfile() 'Roi

Dim curWks As Worksheet
Dim newWks As Worksheet

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

Set curWks = Worksheets("Return Format")
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:=ThisWorkbook.Path & "\" & .Cells(iRow, "A").Value & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Next iRow: iRow = iRow - 1

End With

newWks.Parent.Close savechanges:=False

End Sub

BTW you need to put code tags around your code: Edit - Highlight your code and hit the #

**roi** · 08-12-2013, 05:34 AM

Many Thanks!!!

**roi** · 08-12-2013, 05:44 AM

I have just made the amendment but still gives me the same error message ...

**xladept** · 08-12-2013, 02:09 PM

Can you post a sample? (Go to advanced and click on the paper clip.)

**xladept** · 08-12-2013, 04:02 PM

Maybe:

Sub splitfile() 'Roi
 
Dim curWks As Worksheet
Dim newWks As Worksheet

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

Set curWks = Worksheets("Return Format")
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
If Range("A" & iRow).HasFormula Then Exit For
.Rows(iRow).Copy

With newWks.Range("A2")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With

newWks.Parent.SaveAs _
fileName:=ThisWorkbook.Path & "\" & .Cells(iRow, "A").Value & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Next iRow:iRow=iRow-1

End With

newWks.Parent.Close savechanges:=False

End Sub

**roi** · 08-13-2013, 09:41 AM

Example attached

**xladept** · 08-13-2013, 02:33 PM

Hi Roi,

Try this:

Sub splitfile(): Dim S As String

Dim curWks As Worksheet
Dim newWks As Worksheet

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

Set curWks = Worksheets("Return Format")

With curWks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Do Until curWks.Range("A" & LastRow) <> "": LastRow = LastRow - 1: Loop
Set newWks = Workbooks.Add(1).Worksheets(1)

.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
S = ThisWorkbook.Path & "\" & .Cells(iRow, "A").Value & ".xlsm"
newWks.Parent.SaveAs Filename:=S, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Next iRow

End With

newWks.Parent.Close savechanges:=False

End Sub

It was running over the actual data.

**roi** · 08-14-2013, 05:09 AM

This is perfect! Thanks a million!

**xladept** · 08-14-2013, 12:34 PM

You're welcome!

SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Re: SPLIT .xls IN MULTIPLE FILES BY ROWS AND NAME PER VALUE IN RESPECTIVE CELL

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Can I split up an excel spreadsheet into multiple files by rows?

Split Excel file into multiple files based on number of rows

[SOLVED] Split Workbook into Multiple Files based on Worksheet Name + Cell Value

Split cell into multiple rows

[SOLVED] Ccopy certain cells from other files into respective rows

Bookmarks

Bookmarks

Posting Permissions