I want to multiple workbooks that have the same columns

[Guest]

Hi, I really dont have that much knowledge in this area. I have about 200
worksheets all with the same structure of columns. They have differing data
and all need to be put into 1 workbook. Copy and pasting would obviously do
it but due to the number it would take forever. Any one know what to do?

 

[Ron de Bruin]

Try this
http://www.rondebruin.nl/copy3.htm

 

[Guest]

Hi Ron

I think this is what I need, but am unsure what to do. I downloaded
codefile and i set up 4 test spreadsheets in a file called Data. Now how do
I run your codefile to join all these files into a new spreadsheet? Sorrry
if this is all very basic. Thanks for taking the time to help so far.

Khurum

 

[Ron de Bruin]

Hi Khurum

If you use Alt-F8 you see the list of macro's in the workbook
Select the one you want and press Run

 

[Guest]

Hi Rob

Like a loser I cant get it to work. The list does not detail what each one
does and some of them come up with errors and so dont run. I dont suppose
you know which of the named list is the one im after?

Khurum

 

[Ron de Bruin]

Hi Khurum

This example copy row 2 till the last row with data on each sheet

Open a new workbook
Alt F11
Insert Module
Copy this macro and function in the module

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Sub Example7()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim lrow As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
lrow = LastRow(mybook.Sheets(1))
Set sourceRange = mybook.Worksheets(1).Range("A2:IV" & lrow)
'Copy from A2:IV? (till the last row with data on your sheet)
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values

' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Then Alt q to go back to Excel
Alt F8 to get your macro list
Select Example7 and press Run