I need to split a file [sheet] with potentially thousands of lines into separate workbooks, each being max 99 lines.
Thanks to searching on the site, I have developed some code for a macro that does this as per below, but it is missing one last part that I cannot get my head round. The last file generated still has 99 lines [i.e. if I Ctrl End, then it ends on a cell in row 99]. Because of how I will use the data, I need the file to end on the last row with data in it. Can you advise adaptations to cover this?
Code so far:
Sub split_and_save
Dim sh As Worksheet, newWb As Workbook, fName As String, nbr As Long
Set sh = Sheets(1)
LR = sh.Cells(Rows.Count, 1).End(xlUp).Row
fName = "C:FILE_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss")
nbr = 1
For i = 1 To LR Step 99
Set newWb = Workbooks.Add
newWb.SaveAs fName & "_" & nbr & ".xls", _
FileFormat:=xlExcel5, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
sh.Range("A" & i).Resize(99, 100).Copy newWb.Sheets(1).Range("A1")
ActiveWorkbook.Close SaveChanges:=True
nbr = nbr + 1
Next
ActiveWorkbook.Close SaveChanges:=False
End Sub
Thanks to searching on the site, I have developed some code for a macro that does this as per below, but it is missing one last part that I cannot get my head round. The last file generated still has 99 lines [i.e. if I Ctrl End, then it ends on a cell in row 99]. Because of how I will use the data, I need the file to end on the last row with data in it. Can you advise adaptations to cover this?
Code so far:
Sub split_and_save
Dim sh As Worksheet, newWb As Workbook, fName As String, nbr As Long
Set sh = Sheets(1)
LR = sh.Cells(Rows.Count, 1).End(xlUp).Row
fName = "C:FILE_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss")
nbr = 1
For i = 1 To LR Step 99
Set newWb = Workbooks.Add
newWb.SaveAs fName & "_" & nbr & ".xls", _
FileFormat:=xlExcel5, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
sh.Range("A" & i).Resize(99, 100).Copy newWb.Sheets(1).Range("A1")
ActiveWorkbook.Close SaveChanges:=True
nbr = nbr + 1
Next
ActiveWorkbook.Close SaveChanges:=False
End Sub