View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
James Stephens James Stephens is offline
external usenet poster
 
Posts: 26
Default 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