Copying data from 100 tabs to one summary page

R

Rob P

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
 
M

meh2030

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
 
R

Rob P

Hi there, I have over100tabswith 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




Sub MakeSummary()
'
' MakeSummary Macro
' Macro created 3/26/09 by Gwatcheater
'
'

Sheets("SUMMARY").Select
' Clear the existing values (if any)
Range("$A$2:$D$60").Value = ""
' J tracks the row number on the summary page
' I tracks the sheet number being processed
J = 2
For I = 2 To Sheets.Count
A$ = Sheets(I).Name
' Process the current sheet
Range("B" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C1"
Range("C" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C2"
Range("D" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C3"
Range("E" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C4"
' Copy the sheet name in the A column
' struggling with code for this

J = J + 1

Next I

End Sub
 
M

meh2030

Sub MakeSummary()
'
' MakeSummary Macro
' Macro created 3/26/09 by Gwatcheater
'
'

    Sheets("SUMMARY").Select
'   Clear the existing values (if any)
    Range("$A$2:$D$60").Value = ""
'   J tracks the row number on the summary page
'   I tracks the sheet number being processed
    J = 2
    For I = 2 To Sheets.Count
        A$ = Sheets(I).Name
'   Process the current sheet
        Range("B" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C1"
        Range("C" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C2"
        Range("D" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C3"
        Range("E" + Format(J)).FormulaR1C1 = "='" + A$ + "'!R1C4"
'   Copy the sheet name in the A column
'   struggling with code for this

        J = J + 1

    Next I

End Sub

Rob,

It's good programming practice to enable "Require Variable
Declaration" (Tools | Options; Editor Page). If this is enabled, VBA
will compile your variables and let you know if something is wrong
with your syntax (such as a misspelling). This option will write
"Option Explicit" at the top of modules that are subsequently added.
The option will also require you to dimension the variables, e.g. Dim
j, Dim i, etc. When you dimension your variables you can also assign
a data type, letting VBA know how much memory to allocate to each
variable, e.g. Dim j As Long. If you don't include a data type, VBA
will assign the variable as a variant (which requires the most amount
of memory).

You may not know it, but you have your worksheet name answer already
in your For loop. I've added the line you are looking for, and
changed your A$ variable to strWksName (see below). Also, as a side
note, I noticed you are using Range("A"... but your formulas are R1C1
notation. As a result, I don't know if you prefer R1C1 or A1
notation. I find R1C1 notation less intuitive than the A1 notation.
The following is an alternative to your R1C1 notation: Range("B" &
j).Formula = "='" & strWksName & "'!A1"; the "&" is to concatenate
items (see Excel function help for CONCATENATE).

Best,

Matt

Sub MakeSummary()

Dim j As Long
Dim i As Long
Dim strWksName As String

Sheets("SUMMARY").Select

' Clear the existing values (if any)
Range("$A$2:$D$60").Value = ""

' J tracks the row number on the summary page
' I tracks the sheet number being processed
j = 2
For i = 2 To Sheets.Count
strWksName = Sheets(i).Name
' Process the current sheet
Range("A" + Format(j)).FormulaR1C1 = strWksName
Range("B" + Format(j)).FormulaR1C1 = "='" + strWksName + "'!
R1C1"
Range("C" + Format(j)).FormulaR1C1 = "='" + strWksName + "'!
R1C2"
Range("D" + Format(j)).FormulaR1C1 = "='" + strWksName + "'!
R1C3"
Range("E" + Format(j)).FormulaR1C1 = "='" + strWksName + "'!
R1C4"
' Copy the sheet name in the A column
' struggling with code for this

j = j + 1

Next i

End Sub
 
R

Rob P

Rob,

It's good programming practice to enable "Require Variable
Declaration" (Tools | Options; Editor Page).  If this is enabled, VBA
will compile your variables and let you know if something is wrong
with your syntax (such as a misspelling).  This option will write
"Option Explicit" at the top of modules that are subsequently added.
The option will also require you to dimension the variables, e.g. Dim
j, Dim i, etc.  When you dimension your variables you can also assign
a data type, letting VBA know how much memory to allocate to each
variable, e.g. Dim j As Long.  If you don't include a data type, VBA
will assign the variable as a variant (which requires the most amount
of memory).

You may not know it, but you have your worksheet name answer already
in your For loop.  I've added the line you are looking for, and
changed your A$ variable to strWksName (see below).  Also, as a side
note, I noticed you are using Range("A"... but your formulas are R1C1
notation.  As a result, I don't know if you prefer R1C1 or A1
notation.  I find R1C1 notation less intuitive than the A1 notation.
The following is an alternative to your R1C1 notation:  Range("B" &
j).Formula = "='" & strWksName & "'!A1"; the "&" is to concatenate
items (see Excel function help for CONCATENATE).

Best,

Matt

Sub MakeSummary()

Dim j As Long
Dim i As Long
Dim strWksName As String

   Sheets("SUMMARY").Select

'   Clear the existing values (if any)
   Range("$A$2:$D$60").Value = ""

'   J tracks the row number on the summary page
'   I tracks the sheet number being processed
   j = 2
   For i = 2 To Sheets.Count
       strWksName = Sheets(i).Name
'   Process the current sheet
       Range("A" + Format(j)).FormulaR1C1 = strWksName
       Range("B" + Format(j)).FormulaR1C1 = "='" + strWksName+ "'!
R1C1"
       Range("C" + Format(j)).FormulaR1C1 = "='" + strWksName+ "'!
R1C2"
       Range("D" + Format(j)).FormulaR1C1 = "='" + strWksName+ "'!
R1C3"
       Range("E" + Format(j)).FormulaR1C1 = "='" + strWksName+ "'!
R1C4"
'   Copy the sheet name in the A column
'   struggling with code for this

       j = j + 1

   Next i

End Sub- Hide quoted text -

- Show quoted text -


got it - thank you very much Matt

I now have this working


thanks for your help
 
T

Tree

Hello! Thank you so much for your time and assistance! I have copied the very
helpful macro listed at the website (follows is the example I used) and I
have done something wrong because when I go to run the macro, I get an error
message, INVALID OUTSIDE PROCEDURE. I looked that up and really do not know
how to correct it..
I very much appreciate your assistance.. Follows is what I've inserted in
the module:
The DestSh. in this 2nd line is what's highlighted as part of the error
message..

'Copy header row, change the range if you use more columns
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
sh.Range("A1:Z1").Copy DestSh.Range("A1")
End If

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "RDBMergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "RDBMergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

'Fill in the start row
StartRow = 2

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

'Find the last row with data on the DestSh and sh
Last = LastRow(DestSh)
shLast = LastRow(sh)

'If sh is not empty and if the last row >= StartRow copy the
CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats, if you only want to
copy the
'values or want to copy everything look below example 1 on
this page
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
 

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