Combining data from multiple worksheets into one

M

Mark712

I have 4 files with hundreds of worksheets in each file. I need to combine
all 700,000 rows of data from all the worksheets in these 4 files into one
worksheet to take into Access to append additional data.
Is there a way to do this without cutting and pasting the data from each
individual worksheet into the single list?
I'm using Office 07 and although the data is the same format in each of the
worksheets the entries vary in the number of rows from sheet to sheet.
 
O

Otto Moehrbach

Mark
This macro will do what you want. The following conditions must be met for
this to work.
The 4 workbooks must all be in one folder.
The workbook into which you want the 4 workbooks combined must contain this
macro and must also be in that same folder.
The 4 workbooks' names must all have an extension of ".xlsx".
The workbook that contains this macro must have an extension of ".xlsm".
No other workbooks with the ".xlsx" extension should be in this same folder.
This macro loops through the 4 workbooks, and in each workbook loops through
all the sheets, and copies all the data from A2 down and 10 columns wide and
pastes it into the workbook that holds this macro. Make changes to the code
as needed to fit with your data. Come back if you need more. HTH Otto
Sub AllFolderFiles()
Dim wb As Workbook, wbMaster As Workbook
Dim TheFile As String, MyPath As String
Dim ws As Worksheet, Dest As Range
Set Dest = Range("A2")
Set wbMaster = ThisWorkbook
MyPath = ThisWorkbook.Path
ChDir MyPath
TheFile = Dir("*.xlsx")
Do While TheFile <> ""
If TheFile <> wbMaster.Name Then
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
For Each ws In wb.Worksheets
With ws
.Range("A2", .Range("A" &
Rows.Count).End(xlUp)).Resize(, 10).Copy Dest
End With
Set Dest = wbMaster.Range("A" &
Rows.Count).End(xlUp).Offset(1)
Next ws
wb.Close
End If
TheFile = Dir
Loop
End Sub
 
M

Mark712

Otto,
Thank you for the macro, this will save an incredible amount of time. I'll
try it tomorrow.

Mark
 
M

Mark712

Otto,
On the line, .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(,
10).Copy Dest, I'm getting an error message that says "Copy Method of Range
Calss failed". Any ides what would cause that?

Mark
 
O

Otto Moehrbach

Mark
I set up some files in the same folder as the file with the macro and it
runs fine except for this line:
Set Dest = wbMaster.Range("A" & Rows.Count).End(xlUp).Offset(1)
Change it to:
Set Dest = wbMaster.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
Now to your problem. Did the macro do ANY copying at all? If not, then you
got the error in the first loop.
If you wish, make copies of all 5 of your files and delete most of your data
& sheets in those 5 copies so the whole mass will be smaller. I need jut a
couple of sheets in each file and a dozen rows of data in each sheet. Run
the macro and confirm that you still get that error. Then send me those 5
files and I'll try to figure it out for you. My email is
(e-mail address removed). Remove the "extra" from this email address.
HTH Otto
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top