Combining tables from several spreadsheets

[Stian Berg]

Hi.

I use Excel 2000 and have several sheets that I need to combine. On
every sheet there is a table, starting in A1, that will look something
like this:

(sheet1)
Ugs Uos Uws
A1 - B1 - C1
A2 - B2 - C2

(sheet2)
Ugs Uos Uws
A3 - B3 - C4
A4 - B3 - C4

There are about 40 of these tables on different sheets and I would
like to combine these on one sheet like this:

Ugs Uos Uws
A1 - B1 - C1
A2 - B2 - C2
A3 - B3 - C4
A4 - B3 - C4

How can I do this using VBA? The tables is of course much larger then
what I have shown you.

 

[Ron de Bruin]

Hi Stian

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

 

[Tom Ogilvy]

Dim sh as Worksheet
Dim rng as Range
for each sh in ActiveWorkook.Worksheets
if sh.name <> "Summary" then
set rng = sh.Range("A1").CurrentRegion
' don't include the header row
set rng = rng.offset(1,0).Resize(rng.rows.count-1)
rng.copy Destination:=worksheets("Summary") _
.Cells(rows.count,1).End(xlup)(2)
end if
Next

 

[Guest]

Hi Stian,
Try this, but I'm assuming all tables have 3 columns, but you can modify the code if
not.
HTH Mark

Sub Consolidate_Tables()
' Define Variables
Dim wks As Worksheet, wksConTable As Worksheet
' Add new worksheet for consolidated table
Set wksConTable = ThisWorkbook.Worksheets.Add
' Process each sheet
For Each wks In ThisWorkbook.Worksheets
' If not consolidated sheet
If wks.Name <> wksConTable.Name Then
wks.Activate
' Copy table below current consolidated data
wks.Range(Cells(1, 1), Cells(wks.Cells(Cells.Rows.Count, 1).End(xlUp), 3)).Copy wksConTable.Cells(wksConTable.Cells(Cells.Rows.Count, 1).End(xlUp) + 1, 1)
End If
Next wks
' Clear up
Set wksConTable = Nothing
End Sub

 

[Guest]

If you don't want to include the headers change:
wks.Range(Cells(1, 1), Cells(wks.Cells(Cells.Rows...
to
wks.Range(Cells(2, 1), Cells(wks.Cells(Cells.Rows...

 

[Stian Berg]

Dim sh as Worksheet
Dim rng as Range
for each sh in ActiveWorkook.Worksheets
if sh.name <> "Summary" then
set rng = sh.Range("A1").CurrentRegion
' don't include the header row
set rng = rng.offset(1,0).Resize(rng.rows.count-1)
rng.copy Destination:=worksheets("Summary") _
.Cells(rows.count,1).End(xlup)(2)
end if
Next

What a helpful group this is. Thanks to everyone that answered me,
specially to Tom who’s solution I used.

Best Regards