Consolidating Data to one worksheet

G

Guest

Hello,

I have a workbook with 50+ worksheets that have data in the exact same place
and format. I would like to take the contents of each worksheet and
consolidate it into a single worksheet, working downwards. For example, the
data in all sheets is found in A1:C3. I would like this consolidated
worksheet to have the contents of sheet one be in the same A1:C3, but sheet
two's data would go directly underneath, into cells A4:C6, sheet three's data
into cells A7:C9.... and so on.

Note:
1. The number of original worksheets could grow from 50 to 100
2. The consolidated data could be a new workbook, a new worksheet, or on
the first worksheet

Thanks a lot in advance!
 
N

Nigel

The following will copy the range A1:C3 from every sheet onto the currently
active sheet, but not itself, offsetting the data by the value in xstep.
xlocate define the first copy destination.

Sub ConsSheets()
Dim wS As Worksheet
Dim xstep As Integer, xLocate As Long
xstep = 3: xLocate = 4
For Each wS In ActiveWorkbook.Worksheets
If wS.Index <> ActiveSheet.Index Then
wS.Range("A1:C3").Copy Destination:=ActiveSheet.Cells(xLocate, 1)
xLocate = xLocate + xstep
End If
Next
End Sub
 
G

Guest

hi jeff
try this
dim temparray()

dim totalworksheets as integer
totalworksheets=activeworkbook.worksheets.count
dim n as integer
n=1
for each wk in activeWorkbook
worksheets(n).activate
rowcnt=activesheet.usedrange.rows.count
colcnt=activesheet.usedrange.columns.count
redim preserve temparray(rowcn,colcnt)
with activesheet
for x= 1 to rowcnt
for y= 1 to colcnt
temparray(x,y)=.cells(x,y)
next y
next x
end with
worksheets(totalworksheets+1).activate
with activesheet
for x1 = 1 to ubound(temarray,1)
for y1=ubound(temparray,2)

.cells(x1,y1)=temparray(x1,y1)
next y1
next x1
end with
n=n+1
redim temparray()
next
 
G

Guest

WORKS! thanks

Nigel said:
The following will copy the range A1:C3 from every sheet onto the currently
active sheet, but not itself, offsetting the data by the value in xstep.
xlocate define the first copy destination.

Sub ConsSheets()
Dim wS As Worksheet
Dim xstep As Integer, xLocate As Long
xstep = 3: xLocate = 4
For Each wS In ActiveWorkbook.Worksheets
If wS.Index <> ActiveSheet.Index Then
wS.Range("A1:C3").Copy Destination:=ActiveSheet.Cells(xLocate, 1)
xLocate = xLocate + xstep
End If
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top