Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet
I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data Thanks for any assistance you can give me with this, below is a copy of the code as it stands now Ji Sub CombineWorkbooks( Dim LastRow As Lon Dim basebook As Workboo Dim i As Lon Dim mybook As Workboo With Applicatio .DisplayAlerts = Fals .EnableEvents = Fals .ScreenUpdating = Fals End Wit With Application.FileSearc .NewSearc 'Change this to your director .LookIn = ThisWorkbook.Path & "\ProgramData\ .SearchSubFolders = Fals .FileType = msoFileTypeExcelWorkbook If .Execute() 0 The Set basebook = Workbooks.Open(.FoundFiles(1) For i = 2 To .FoundFiles.Coun Set mybook = Workbooks.Open(.FoundFiles(i) With ActiveShee LastRow = .Cells(.Rows.Count, "A").End(xlUp).Ro .Range("a1").Resize(LastRow, 18).Copy basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0 End Wit mybook.Clos Next ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat :=xlText, CreateBackup:=Fals ActiveWorkbook.Clos End I End Wit With Applicatio .DisplayAlerts = Tru .EnableEvents = Tru End Wit End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
James
you establish the LastRow on each sheet you intend to copy. You also work out the last row on the target/master sheet. So, you need a simple calculation: if "last row" + "master last row" 65,536, start a new "master sheet" and reset the "master last row" to 1 Straightforward in principle ... mmmm, in principle ! Regards Trevor "James Stephens" wrote in message ... I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet. I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
How about this:
Option Explicit Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook Dim DestCell As Range Dim RngToCopy As Range With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) With basebook.Worksheets(1) Set DestCell = .Cells(.Rows.Count, "A").End(xlUp) End With For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet 'column R = 18th column Set RngToCopy = .Range("a1:R" & _ .Cells(.Rows.Count, "A").End(xlUp).Row) End With If (DestCell.Row + RngToCopy.Rows.Count) _ < DestCell.Parent.Rows.Count Then 'ok to paste, just come down one. Set DestCell = DestCell.Offset(1, 0) Else 'too many rows, make a new sheet Set DestCell = basebook.Worksheets.Add.Range("a1") End If RngToCopy.Copy _ Destination:=DestCell mybook.Close Next i 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs _ Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" _ & "Report1.xls", _ FileFormat:=xlText, CreateBackup:=False 'ActiveWorkbook.Close savechanges:=false 'just saved End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub But this scares me: 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs _ Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" _ & "Report1.xls", _ FileFormat:=xlText, CreateBackup:=False First, you don't need to change directories to save to that folder. Just include it in the filename. But you have it saving as xlText. I bet you want a normal workbook. xlNormal makes more sense to me. James Stephens wrote: I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet. I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
Ok, I tried what you had, and looking at it, it makes sense. But there is a problem and I am not sure what it is, or if I did something wrong. I tested it with 40 files and I know that total of these should at least force a third page. As results though, all I am getting is a complete copy of the first file, one line copied from each additional file and then a complete copy of the last file, all put in one list. I will look to see if I can figure out the error, but your further help would be appreciated
Thanks Ji ----- Dave Peterson wrote: ---- How about this Option Explici Sub CombineWorkbooks( Dim LastRow As Lon Dim basebook As Workboo Dim i As Lon Dim mybook As Workboo Dim DestCell As Rang Dim RngToCopy As Rang With Applicatio .DisplayAlerts = Fals .EnableEvents = Fals .ScreenUpdating = Fals End Wit With Application.FileSearc .NewSearc 'Change this to your director .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = Fals .FileType = msoFileTypeExcelWorkbook If .Execute() 0 The Set basebook = Workbooks.Open(.FoundFiles(1) With basebook.Worksheets(1 Set DestCell = .Cells(.Rows.Count, "A").End(xlUp End Wit For i = 2 To .FoundFiles.Coun Set mybook = Workbooks.Open(.FoundFiles(i) With ActiveShee 'column R = 18th colum Set RngToCopy = .Range("a1:R" & .Cells(.Rows.Count, "A").End(xlUp).Row End Wit If (DestCell.Row + RngToCopy.Rows.Count) < DestCell.Parent.Rows.Count The 'ok to paste, just come down one Set DestCell = DestCell.Offset(1, 0 Els 'too many rows, make a new shee Set DestCell = basebook.Worksheets.Add.Range("a1" End I RngToCopy.Copy Destination:=DestCel mybook.Clos Next 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" & "Report1.xls", FileFormat:=xlText, CreateBackup:=Fals 'ActiveWorkbook.Close savechanges:=false 'just save End I End Wit With Applicatio .DisplayAlerts = Tru .EnableEvents = Tru End Wit End Su But this scares me 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" & "Report1.xls", FileFormat:=xlText, CreateBackup:=Fals First, you don't need to change directories to save to that folder. Jus include it in the filename But you have it saving as xlText. I bet you want a normal workbook. xlNorma makes more sense to me James Stephens wrote I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
On looking at the issue more, it looks like it takes the first book as the starting one and then pastes data to it from the others. It looks like it takes the next book and pastes it to first open row, say that is 6500, then it takes the next book and pastes it to row 6501 and so on, I am not sure but that is the best that I can tell what is going on. I am not even more confused and really need some guidance, because it looked like what you had should work, but I am getting this situation
Thanks Ji ----- Dave Peterson wrote: ---- How about this Option Explici Sub CombineWorkbooks( Dim LastRow As Lon Dim basebook As Workboo Dim i As Lon Dim mybook As Workboo Dim DestCell As Rang Dim RngToCopy As Rang With Applicatio .DisplayAlerts = Fals .EnableEvents = Fals .ScreenUpdating = Fals End Wit With Application.FileSearc .NewSearc 'Change this to your director .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = Fals .FileType = msoFileTypeExcelWorkbook If .Execute() 0 The Set basebook = Workbooks.Open(.FoundFiles(1) With basebook.Worksheets(1 Set DestCell = .Cells(.Rows.Count, "A").End(xlUp End Wit For i = 2 To .FoundFiles.Coun Set mybook = Workbooks.Open(.FoundFiles(i) With ActiveShee 'column R = 18th colum Set RngToCopy = .Range("a1:R" & .Cells(.Rows.Count, "A").End(xlUp).Row End Wit If (DestCell.Row + RngToCopy.Rows.Count) < DestCell.Parent.Rows.Count The 'ok to paste, just come down one Set DestCell = DestCell.Offset(1, 0 Els 'too many rows, make a new shee Set DestCell = basebook.Worksheets.Add.Range("a1" End I RngToCopy.Copy Destination:=DestCel mybook.Clos Next 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" & "Report1.xls", FileFormat:=xlText, CreateBackup:=Fals 'ActiveWorkbook.Close savechanges:=false 'just save End I End Wit With Applicatio .DisplayAlerts = Tru .EnableEvents = Tru End Wit End Su But this scares me 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" & "Report1.xls", FileFormat:=xlText, CreateBackup:=Fals First, you don't need to change directories to save to that folder. Jus include it in the filename But you have it saving as xlText. I bet you want a normal workbook. xlNorma makes more sense to me James Stephens wrote I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub -- Dave Peterson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
Ok, I think I may have fixed my issue.
With basebook.Worksheets(1 Set DestCell = .Cells(.Rows.Count, "A").End(xlUp End Wit This was not in the loop so the DestCell value wasn't recalculating each time. It appears to work now, I just moved the line For i = 2 To .FoundFiles.Coun up, so that the with statement is now included in the loop. I would appreciate it though if you can verify that what I did is correct and doesn't cause the data to be invalid for any reason. It looks good to me though Thanks Ji ----- Dave Peterson wrote: ---- How about this Option Explici Sub CombineWorkbooks( Dim LastRow As Lon Dim basebook As Workboo Dim i As Lon Dim mybook As Workboo Dim DestCell As Rang Dim RngToCopy As Rang With Applicatio .DisplayAlerts = Fals .EnableEvents = Fals .ScreenUpdating = Fals End Wit With Application.FileSearc .NewSearc 'Change this to your director .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = Fals .FileType = msoFileTypeExcelWorkbook If .Execute() 0 The Set basebook = Workbooks.Open(.FoundFiles(1) With basebook.Worksheets(1 Set DestCell = .Cells(.Rows.Count, "A").End(xlUp End Wit For i = 2 To .FoundFiles.Coun Set mybook = Workbooks.Open(.FoundFiles(i) With ActiveShee 'column R = 18th colum Set RngToCopy = .Range("a1:R" & .Cells(.Rows.Count, "A").End(xlUp).Row End Wit If (DestCell.Row + RngToCopy.Rows.Count) < DestCell.Parent.Rows.Count The 'ok to paste, just come down one Set DestCell = DestCell.Offset(1, 0 Els 'too many rows, make a new shee Set DestCell = basebook.Worksheets.Add.Range("a1" End I RngToCopy.Copy Destination:=DestCel mybook.Clos Next 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" & "Report1.xls", FileFormat:=xlText, CreateBackup:=Fals 'ActiveWorkbook.Close savechanges:=false 'just save End I End Wit With Applicatio .DisplayAlerts = Tru .EnableEvents = Tru End Wit End Su But this scares me 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\ ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" & "Report1.xls", FileFormat:=xlText, CreateBackup:=Fals First, you don't need to change directories to save to that folder. Jus include it in the filename But you have it saving as xlText. I bet you want a normal workbook. xlNorma makes more sense to me James Stephens wrote I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub -- Dave Peterson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
Oops. You're correct that I had a problem with the original code.
I think that just adding the rngtocopy.rows.count to the destcell's row will do it. I added it right he RngToCopy.Copy _ Destination:=DestCell 'Next line was added... Set DestCell = DestCell.Offset(RngToCopy.Rows.Count) mybook.Close James Stephens wrote: Ok, I think I may have fixed my issue. With basebook.Worksheets(1) Set DestCell = .Cells(.Rows.Count, "A").End(xlUp) End With This was not in the loop so the DestCell value wasn't recalculating each time. It appears to work now, I just moved the line, For i = 2 To .FoundFiles.Count up, so that the with statement is now included in the loop. I would appreciate it though if you can verify that what I did is correct and doesn't cause the data to be invalid for any reason. It looks good to me though. Thanks, Jim ----- Dave Peterson wrote: ----- How about this: Option Explicit Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook Dim DestCell As Range Dim RngToCopy As Range With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) With basebook.Worksheets(1) Set DestCell = .Cells(.Rows.Count, "A").End(xlUp) End With For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet 'column R = 18th column Set RngToCopy = .Range("a1:R" & _ .Cells(.Rows.Count, "A").End(xlUp).Row) End With If (DestCell.Row + RngToCopy.Rows.Count) _ < DestCell.Parent.Rows.Count Then 'ok to paste, just come down one. Set DestCell = DestCell.Offset(1, 0) Else 'too many rows, make a new sheet Set DestCell = basebook.Worksheets.Add.Range("a1") End If RngToCopy.Copy _ Destination:=DestCell mybook.Close Next i 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs _ Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" _ & "Report1.xls", _ FileFormat:=xlText, CreateBackup:=False 'ActiveWorkbook.Close savechanges:=false 'just saved End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub But this scares me: 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs _ Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" _ & "Report1.xls", _ FileFormat:=xlText, CreateBackup:=False First, you don't need to change directories to save to that folder. Just include it in the filename. But you have it saving as xlText. I bet you want a normal workbook. xlNormal makes more sense to me. James Stephens wrote: I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet. I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub -- Dave Peterson -- Dave Peterson |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Working Around Excel Row Limit
One more thing.
I know that when I work with lots of data in a worksheet, excel can slow down to a crawl. You may want to use a smaller number than 65536 when you go to the new sheet: this line: < DestCell.Parent.Rows.Count Then could change to: < 40000 Then (or your favorite row) Dave Peterson wrote: Oops. You're correct that I had a problem with the original code. I think that just adding the rngtocopy.rows.count to the destcell's row will do it. I added it right he RngToCopy.Copy _ Destination:=DestCell 'Next line was added... Set DestCell = DestCell.Offset(RngToCopy.Rows.Count) mybook.Close James Stephens wrote: Ok, I think I may have fixed my issue. With basebook.Worksheets(1) Set DestCell = .Cells(.Rows.Count, "A").End(xlUp) End With This was not in the loop so the DestCell value wasn't recalculating each time. It appears to work now, I just moved the line, For i = 2 To .FoundFiles.Count up, so that the with statement is now included in the loop. I would appreciate it though if you can verify that what I did is correct and doesn't cause the data to be invalid for any reason. It looks good to me though. Thanks, Jim ----- Dave Peterson wrote: ----- How about this: Option Explicit Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook Dim DestCell As Range Dim RngToCopy As Range With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) With basebook.Worksheets(1) Set DestCell = .Cells(.Rows.Count, "A").End(xlUp) End With For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet 'column R = 18th column Set RngToCopy = .Range("a1:R" & _ .Cells(.Rows.Count, "A").End(xlUp).Row) End With If (DestCell.Row + RngToCopy.Rows.Count) _ < DestCell.Parent.Rows.Count Then 'ok to paste, just come down one. Set DestCell = DestCell.Offset(1, 0) Else 'too many rows, make a new sheet Set DestCell = basebook.Worksheets.Add.Range("a1") End If RngToCopy.Copy _ Destination:=DestCell mybook.Close Next i 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs _ Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" _ & "Report1.xls", _ FileFormat:=xlText, CreateBackup:=False 'ActiveWorkbook.Close savechanges:=false 'just saved End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub But this scares me: 'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs _ Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\" _ & "Report1.xls", _ FileFormat:=xlText, CreateBackup:=False First, you don't need to change directories to save to that folder. Just include it in the filename. But you have it saving as xlText. I bet you want a normal workbook. xlNormal makes more sense to me. James Stephens wrote: I am looking for some advise on working around the excel row limit. I have the below formula that takes all workbooks in one folder, combines them into one new file and saves it into another folder. The issue is sometimes the amount of data will exceed the 65,536 row limitation. What I am looking for is a way to modify this so that if that limit is reached, a new sheet gets created and the data continues to be pasted into that sheet. This might need to go as high as four or five sheets. After that I have code that modifies this data considerably, but I think I can just use the code I have and modify it to do what it does to each sheet in the workbook instead of a specific worksheet. I have searched around on google and haven't really found a way to modify this code. Any help would be great. I just need to find a way for this to simply create a new page when the limit is reached and continue copying and pasting data. Thanks for any assistance you can give me with this, below is a copy of the code as it stands now. Jim Sub CombineWorkbooks() Dim LastRow As Long Dim basebook As Workbook Dim i As Long Dim mybook As Workbook With Application .DisplayAlerts = False .EnableEvents = False .ScreenUpdating = False End With With Application.FileSearch .NewSearch 'Change this to your directory .LookIn = ThisWorkbook.Path & "\ProgramData\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = Workbooks.Open(.FoundFiles(1)) For i = 2 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("a1").Resize(LastRow, 18).Copy _ basebook.Worksheets(1).Range("a1").End(xlDown).Off set(1, 0) End With mybook.Close Next i ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\" ActiveWorkbook.SaveAs FileName:="Report1.xls", FileFormat _ :=xlText, CreateBackup:=False ActiveWorkbook.Close End If End With With Application .DisplayAlerts = True .EnableEvents = True End With End Sub -- Dave Peterson -- Dave Peterson -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Working Around 240 Character PRN Field Width Limit | Excel Discussion (Misc queries) | |||
how do i remove the limit set on the worskheet i am working on | Excel Discussion (Misc queries) | |||
Row limit in Excel | Excel Discussion (Misc queries) | |||
Row Limit in Excel | Excel Discussion (Misc queries) | |||
Nested IF limit or Open parentheses limit | Excel Discussion (Misc queries) |