Hi there, I have over 100 tabs with numerical data - each tab is named
I want to create a summary on one tab
I am having problems writing a macro to copy the data from each tab
onto the summary page
I want to paste each tab name on the summary sheet in column A with
the data in rows starting in Column B
i have written the loop - but am struggling to include the tab names -
can anyone help with this code?
any ideas? many thanks
Rob P,
As Tim mentioned, post the portion of "the loop" you wrote and
reference your question in relation to that loop. I initally read
your post as a broad description of what you are trying to accomplish
with a single question: how do I include the "tab name" on the summary
page? (This could be accomplished through something like the
following: Worksheets("Sheet1").Range("a1").Value = Worksheets
("Sheet2").Name). You are more likely to get a more direct answer
when you post code along with a detailed question, rather than asking
a high-level question; unless you are indeed looking for a high-level
answer.
I did, however, infer what it is that you are trying to accomplish
(and this is assuming I inferred correctly based on your post). The
sample commented code below does not include any error checking and
assumes that the data is in the appropriate places. I spent very
little time testing it.
Best,
Matt Herbert
Sub LoopWorksheets()
Dim Wks As Worksheet
Dim wksSumm As Worksheet
Dim rngSumm As Range
Dim rngPaste As Range
Dim rngWksData As Range
Dim rngWksName As Range
Dim rngBottomRight As Range
Dim lngOffsetCol As Long
'assuming your Summary worksheet is called "Summary"
Set wksSumm = Worksheets("Summary")
For Each Wks In ActiveWorkbook.Worksheets
If Wks.Name <> wksSumm.Name Then
'get Wks data
With Wks
'assumes the data starts in the upper-left corner
' of wksSumm and is contiguous
Set rngWksData = .Range("a1").CurrentRegion
'shift the range down 1 row (assumes each Wks has a
' header for the data; this header doesn't need to be
' copied to wksSumm)
Set rngWksData = rngWksData.Offset(1, 0)
'resize the range to eliminate the last row which
' shifted from Offset
Set rngWksData = rngWksData.Resize(rngWksData.Rows.Count -
1, _
rngWksData.Columns.Count)
End With
'paste Wks data to wksSumm
With wksSumm
'assumes the data starts in the upper-left corner
' of wksSumm and is contiguous; will error if no
' data is on the sheet
Set rngSumm = .Range("a1").CurrentRegion
'set the paste range as the last row in the data
' range
Set rngPaste = .Range("a" & rngSumm.Rows.Count + 1)
'set the paste range as the cell one to the right
' and one down from the lower-left most cell in
' rngSumm
Set rngPaste = rngPaste.Offset(0, 1)
End With
'this will write the range address to the Immediate window
' (View | Immediate Window); as you step through the program,
' i.e. F8 repeatedly, you'll be able to see how the ranges
' are behaving
Debug.Print "rngSumm :"; rngSumm.Address(external:=True)
Debug.Print "rngPste :"; rngPaste.Address(external:=True)
Debug.Print "rngWksDt:"; rngWksData.Address(external:=True)
'paste the data to wksSumm
rngWksData.Copy rngPaste
Application.CutCopyMode = False
'paste wksName in column A next to pasted data
With wksSumm
'same assumption as above (start cell and contiguous)
Set rngWksName = .Range("a1").CurrentRegion
'get bottom-right corner cell
Set rngBottomRight = rngWksName.Cells
(rngWksName.Cells.Count)
'offset column
lngOffsetCol = rngWksName.Columns.Count
'get lower-left cell
Set rngWksName = rngBottomRight.Offset(0, -1 *
lngOffsetCol + 1)
'get empty cells above the lower-left cell
Set rngWksName = .Range(rngWksName, rngWksName.End
(xlUp).Offset(1, 0))
Debug.Print "rngWksNm:"; rngWksName.Address
(external:=True)
rngWksName.Value = Wks.Name
End With
End If
Next
End Sub
