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