Hi,

I am needing a VBA script to combine multiple workbooks of multiple sheets
to a single worksheet. Basically i have a lot of workbooks which have all the
same headers but i want to combine all of these into one big speadsheet.

I have found the script below which i have tried to use but it copies over
the top of every worksheet so it will only show the last one.

any ideas of how i can make it join to the bottom rather than over the top?

thank you!


Sub ImportDistricts()

Dim x As Long, z As Variant
Dim bk As Workbook, sh As Worksheet
Dim sh1 As Worksheet

'
' Change the next line to reflect the proper
' name and workbook where the data will be
' consolidated
'

Set sh = Workbooks("SummaryBecsAll.xls").Worksheets("BecsAl l")


z = Application.GetOpenFilename(FileFilter:= _
"Excel files (*.xls), *.xls", MultiSelect:=True)
If Not IsArray(z) Then
MsgBox "Nothing selected"
Exit Sub
End If

'Open loop for action to be taken on all selected workbooks.

For x = 1 To UBound(z)

'Open the workbook(s) that were selected.
Set bk = Workbooks.Open(z(x))
'Check if sheet Mon1 exists
'Check if sheet Mon2 exists
'Check if sheet Mon3 exists
'Check if sheet Mon4 exists
'Check if sheet Mon5 exists
'Dont process a sheet if its name is "cover"
On Error Resume Next
Set sh1 = bk.Worksheets("Mon1")
Set sh1 = bk.Worksheets("Mon2")
Set sh1 = bk.Worksheets("Mon3")
Set sh1 = bk.Worksheets("Mon4")
Set sh1 = bk.Worksheets("Mon5")
On Error GoTo 0
' if it exists, copy the data
If Not sh1 Is Nothing Then
Set rng = sh1.Range("A2:X1646")
Set rng1 = sh.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy
rng1.PasteSpecial xlValues
rng1.PasteSpecial xlFormats
End If

'Close the District workbook without saving it.
bk.Close False

Next x


'Message box to inform user the job is complete.
MsgBox "The import is complete.", 64, "Done !!"
End Sub