merge workbooks
 

I have 40 Workbooks, that I wish to merge into one.

Rows 1 to 4 on the workbooks are identical, containing column headers and
data entry instructions so all I want to merge is everything that appears on
or after row 5.

I have tried, unsuccessfuly, to adapt the script below, found on here but
this seems to hit problems due to the fact all my workbooks have Userforms on
them and I'm not entirely sure how the 'range' is specified

-------------
Sub merge()
Set active = ActiveSheet

With Application.FileSearch
.NewSearch
.LookIn = "J:\Revenue Accounts\FRAUD DATA\New Folder\"
If .LookIn = "" Then Exit Sub
.SearchSubFolders = True
.FileName = "*.xls"
.Execute

Rownumber = 2

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(FileName:=.FoundFiles(i))
Set myrange = Range("a2:b" & Range("a5").CurrentRegion.Rows.Count)
myrange.Copy active.Cells(Rownumber, 1)
Rownumber = Rownumber + myrange.Rows.Count
ActiveWorkbook.Close

Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

------------
Can anybody give any help and/or suggestions on how to do this?

Regards
John

merge workbooks
 

Hi

See http://www.rondebruin.nl/copy3.htm

Try this example
http://www.rondebruin.nl/copy3.htm#header


--
Regards Ron De Bruin
http://www.rondebruin.nl



"mg_sv_r" wrote in message ...
I have 40 Workbooks, that I wish to merge into one.

Rows 1 to 4 on the workbooks are identical, containing column headers and
data entry instructions so all I want to merge is everything that appears on
or after row 5.

I have tried, unsuccessfuly, to adapt the script below, found on here but
this seems to hit problems due to the fact all my workbooks have Userforms on
them and I'm not entirely sure how the 'range' is specified

-------------
Sub merge()
Set active = ActiveSheet

With Application.FileSearch
.NewSearch
.LookIn = "J:\Revenue Accounts\FRAUD DATA\New Folder\"
If .LookIn = "" Then Exit Sub
.SearchSubFolders = True
.FileName = "*.xls"
.Execute

Rownumber = 2

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(FileName:=.FoundFiles(i))
Set myrange = Range("a2:b" & Range("a5").CurrentRegion.Rows.Count)
myrange.Copy active.Cells(Rownumber, 1)
Rownumber = Rownumber + myrange.Rows.Count
ActiveWorkbook.Close

Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

------------
Can anybody give any help and/or suggestions on how to do this?

Regards
John