MS Excel VBA Worksheets group tables in one table.

[How Two]

Is this possible in MS excel using vba?... I tried the recording macro
but does not work properly....

I have a workbook which contains a number of worksheets. In each of
these worksheets, there are three areas which I would like to cut and
paste and merge into one central worksheet table (Central Worksheet).
For example,

In one worksheet of many worksheets the data is located in 3 areas:

Worksheet1
Area A1: Range("A13:G26").Select
Area A2: Range("J13:O26").Select
Area A3: Range("R13:V26").Select


I need a macro which goes through a defined list of worksheets in the
VBA code where this marco would copy the three areas data from each of
these defined worksheets and then paste into one central worksheet. So
the end result would be a big table in a (Central worksheet) with all
the data of area 1,2,3 from each of the worksheets.

Note the Area will vary in height: so it may copy starting at row 13,
but the row depth may to which it copies may be row 26 or more
depending how long the table is.

Worksheet2
Area B1: Range("A13:G29").Select
Area B2: Range("J13:O29).Select
Area B3: Range("R13:V29").Select

Worksheet3
Area C1: Range("A13:G57").Select
Area C2: Range("J13:O57).Select
Area C3: Range("R13:V57").Select


Central Worksheet big table will look like this below:

Area A1, Area A2 , Area A3
Area B1, 'Area B2, Area B3
Area C1, Area C2 Area C3
.........


Is this doable, any help would be appreciated.

 

[Per Jessen]

Hi

This should do what you need:

Sub CopyPaste()
Dim DestCell As Range
Dim CopyRng As Range
Dim LastRow As Long
Dim SheetArr As Variant

Set DestCell = Worksheets("Central Sheet").Range("A2")
'Change Sheet name and cell above to suit
SheetArr = Split("Sheet1,Sheet2,Sheet3", ",") 'Sheets to copy from
For sh = 0 To UBound(SheetArr)
With Worksheets(SheetArr(sh))
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set CopyRng = .Range("A13:G" & LastRow & ",J13:O" _
& LastRow & ",R13:V" & LastRow)
CopyRng.Copy DestCell
End With
Set DestCell = DestCell.End(xlDown).Offset(1, 0)
Next
End Sub

Regards,
Per