Macro to extract data from multiple worksheets

J

JAMhome

New Member
Joined
Apr 28, 2011
Messages
41
<!-- / icon and title --><!-- message -->Hi

I have a workbook with many worksheets. The individual worksheets are time sheets. When needed a macro executes a blank sheet, the user fills it in, and so on. These worksheet tabs are TS1, TS2, TS3, etc. There is another sheet that the user needs to fill-in on occasion. When needed a macro executes a blank sheet, the user fills it in, and so on. These worksheet tabs are CTS1, CTS2, etc. I need a summary sheet bringing in all the worksheet tabs named TS1, etc. and CTS1, etc. I have looked at a lot of code but can’t find anything that quite matches my request. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
On the TS1 worksheet’s the following cells are needed:<o:p></o:p>
C6=Name/Location
C7=Date<o:p></o:p>
C11=Hourly Rate<o:p></o:p>
E11=Hours Worked<o:p></o:p>
G11=Shift Total<o:p></o:p>
On the CTS worksheets the following cells are needed:<o:p></o:p>
C2=Date<o:p></o:p>
D4=Name/Location<o:p></o:p>
F33=Hours Worked<o:p></o:p>
G33=Hourly Rate<o:p></o:p>
H33=Shift Total<o:p></o:p>
On the summary sheet I would need these column headings.
<o:p>Very much a newbie. Posted to any area with a similiar thread--sorry about that! </o:p>
<o:p>Jam</o:p>
<!-- / message -->
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Hi JAMhome,

I think I have a good idea what you need, but I can't look at it until later.

If someone else can come up with something in the mean time all well and good.

Can you post back to me if you don't get any other responses.
 
Upvote 0
This should get you started.

You'll have to copy the second part of the code and change the column and cell you want to reference based on what you want copied over from other sheets.


Sub SumWKS()

'Add worksheet named summary to the end of your wks
Worksheets.Add
With ActiveSheet
.Move After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Summary"
End With



'Cycle through all sheets not named summary and copy the value on the next available row in column A
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not (wks.Name = "Summary") Then
ThisWorkbook.Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value _
= wks.Range("C6").Value
End If
Next




End Sub
Click to expand...
P.S.
Colin is the man!
 
Last edited:
Upvote 0
Hi Ody

I am getting confused. I found this code and I really like it but when I try to incorporate the worksheet CTS1...it erases the the data on the above row. I did not include all cells. Can you look at this code and give me an opinion before I try your method? This is what it produces on the summary sheet:
<TABLE style="WIDTH: 363pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=484><COLGROUP><COL style="WIDTH: 72pt; mso-width-source: userset; mso-width-alt: 3510" width=96><COL style="WIDTH: 51pt; mso-width-source: userset; mso-width-alt: 2486" width=68><COL style="WIDTH: 48pt" span=5 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 72pt; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl64 height=20 width=96>Cost Summary</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 51pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=68></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 height=20>Worksheets</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>Date</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>Name/Location</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>Hourly Rate</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>Hours Worked</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0; mso-ignore: colspan" class=xl65 colSpan=2>Shift Total</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 height=20>TS1</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl68></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0">DEPUTY DOG</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl67 align=right>$79.00 </TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl67 align=right>$260.00 </TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 height=20>TS2</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl68></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0">RICHIE RICH</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl67 align=right>$79.00 </TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl67 align=right>$158.00 </TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 height=20>CTS1</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl68 align=right>5/25/2011</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>3</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 height=20>CTS2</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl68 align=right>5/30/2011</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>3</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 height=20>CTS3</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl68 align=right>5/29/2011</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>4</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0">

</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD></TR></TBODY></TABLE>




Sub GrabData()
'
' GrabData Macro
' Macro recorded 2/12/2009
' Copy all data from every sheet to current sheet
'
Dim wsA As Worksheet
Dim wsANm As String
Dim ws As Worksheet
Dim r As Integer
'
Set wsA = Worksheets.Add(Before:=Worksheets(1))
wsANm = wsA.Name
On Error Resume Next
wsA.Name = "Merged Data"
NameErr: If Err.Number = 1004 Then
Application.DisplayAlerts = False
Sheets("Merged Data").Delete
Application.DisplayAlerts = True
wsA.Name = "Merged Data"
End If
If wsA.Name = wsANm Then GoTo NameErr
On Error GoTo 0
'
For Each ws In Worksheets
If ws.Index <> wsA.Index And ws.Name <> "Summary" Then
r = wsA.Range("A65536").End(xlUp).Row + 1
ws.UsedRange.Copy Destination:=wsA.Cells(r, 1)
End If
Next ws
wsA.Range("A1").Select
'
End Sub

Sub SummarySheet()
'
' SummarySheet Macro
' Macro recorded 2/12/2009
' Create links to all sheets and show totals
'
Dim ws As Worksheet
Dim wsANm As String
Dim wsA As Worksheet
Dim r As Integer
Dim MyTot1 As Variant
Dim MyTot2 As Variant
Dim MyTot3 As Variant
Dim MyTot4 As Variant
Dim MyTot5 As Variant
Dim MyTot6 As Variant
Dim MyTot7 As Variant
'
' Cell that has the totals on each sheet
Set MyTot1 = Range("c7")
Set MyTot2 = Range("c6")
Set MyTot3 = Range("C11")
Set MyTot4 = Range("e11")
Set MyTot5 = Range("g11")
Set MyTot6 = Range("c2")
Set MyTot7 = Range("f33")
'
Set wsA = Worksheets.Add(Before:=Worksheets(1))
MyTot1 = MyTot1.Address
MyTot2 = MyTot2.Address
MyTot3 = MyTot3.Address
MyTot4 = MyTot4.Address
MyTot5 = MyTot5.Address
MyTot6 = MyTot6.Address
MyTot7 = MyTot7.Address
wsANm = wsA.Name
On Error Resume Next
wsA.Name = "Summary"
NoName: If Err.Number = 1004 Then
Application.DisplayAlerts = False
Sheets("Summary").Delete
Application.DisplayAlerts = True
wsA.Name = "Summary"
End If
If wsA.Name = wsANm Then GoTo NoName
On Error GoTo 0
'
r = wsA.Range("B65536").End(xlUp).Row + 1
wsA.Cells(r, 2).Value = "Cost Summary"
wsA.Cells(r, 2).Font.Bold = True
wsA.Cells(r + 2, 2).Value = "Worksheets"
wsA.Cells(r + 2, 2).Font.Italic = True
wsA.Cells(r + 2, 3).Value = "Date"
wsA.Cells(r + 2, 3).Font.Italic = True
wsA.Cells(r + 2, 4).Value = "Name/Location"
wsA.Cells(r + 2, 4).Font.Italic = True
wsA.Cells(r + 2, 5).Value = "Hourly Rate"
wsA.Cells(r + 2, 5).Font.Italic = True
wsA.Cells(r + 2, 6).Value = "Hours Worked"
wsA.Cells(r + 2, 6).Font.Italic = True
wsA.Cells(r + 2, 7).Value = " Shift Total"
wsA.Cells(r + 2, 7).Font.Italic = True
For Each ws In Worksheets
If ws.Index <> wsA.Index And ws.Name <> "Merged Data" And ws.Name <> "Stats" And ws.Name <> "BlankTS" And ws.Name <> "BlankChkpt" And ws.Name <> "DATES" And ws.Name <> "Extracted Dates(1)" And ws.Name <> "Extracted Stats(1)" And ws.Name <> "Holiday" And ws.Name <> "Cover" Then
r = Range("B65536").End(xlUp).Row + 1
wsA.Hyperlinks.Add Anchor:=wsA.Cells(r, 2), Address:="", _
SubAddress:=ws.Name & "!A1", TextToDisplay:=ws.Name
wsA.Cells(r, 3).Value = ws.Range(MyTot1).Value
wsA.Cells(r, 4).Value = ws.Range(MyTot2).Value
wsA.Cells(r, 5).Value = ws.Range(MyTot3).Value
wsA.Cells(r, 6).Value = ws.Range(MyTot4).Value
wsA.Cells(r, 7).Value = ws.Range(MyTot5).Value
wsA.Cells(r, 3).Value = ws.Range(MyTot6).Value
wsA.Cells(r, 6).Value = ws.Range(MyTot7).Value
End If
Next ws
wsA.Range("A1").Select
Columns("B:C").EntireColumn.AutoFit

When I include the CTS time sheets it bombs on this line:
ws.UsedRange.Copy Destination:=wsA.Cells(r, 1)

I was hoping to use this code because I like the hyperlinks. I am sorry I did not share this in my original request. I appreciate all the help I can get.

JAM
 
Last edited:
Upvote 0
Hi JAM,

Can't get my head around this code.

Tell me, do the users all use this one WB, if so, what would you expect the maximum number of TS & CTS would be.
 
Upvote 0
Hi Colin

The wb would be distributed to 80 agencies. The maximum number of CTS would be five. The maximum number of TS1 could be twenty. It will vary per agency. The code I am trying to alter was designed for one cell and one worksheet name. Because it could be many TS1, I thought the hyperlink would come in handy for the user. The TS1 are time sheets that need to be printed out per individual. The CTS are another time sheet that some sites use some do not use. It seems to me if I could alter this piece of the code it would work:

r = Range("B65536").End(xlUp).Row + 1
wsA.Hyperlinks.Add Anchor:=wsA.Cells(r, 2), Address:="", _
SubAddress:=ws.Name & "!A1", TextToDisplay:=ws.Name
wsA.Cells(r, 3).Value = ws.Range(MyTot1).Value
wsA.Cells(r, 4).Value = ws.Range(MyTot2).Value
wsA.Cells(r, 5).Value = ws.Range(MyTot3).Value
wsA.Cells(r, 6).Value = ws.Range(MyTot4).Value
wsA.Cells(r, 7).Value = ws.Range(MyTot5).Value
wsA.Cells(r, 3).Value = ws.Range(MyTot6).Value
wsA.Cells(r, 6).Value = ws.Range(MyTot7).Value

I was thinking an offset code would do the trick, but I do not know how to write that into this mix.

If I have to I can try something else.

JAM
 
Upvote 0
Hi JAM,

Hope you don't mind, but I've put together an example WB which is similar to one I worked on with an other Forum user.

The example WB is called TSWB, and can be downloaded from:

http://www.box.net/shared/8qlhpctij9

You'll see on the Summary, 2 entries for each type of sheet as your example. The Sheet names in column A are formated differently, if you click on one, the appropriate sheet will be displayed. When you click back to the summary, the other Tab is removed from veiw.

There are two buttons on the Summary sheet, when you click on either of these they insert a new Tab of the appropriate type, named sequentially
and linked to the summary sheet.

See what you think.
 
Upvote 0
Hi Colin and Ody

I made the two time sheets equal the same cell locations of the data I need to create the summary sheet. They were similiar so all I had to do was some slight modifications. Once I did this the macro worked perfectly with everything lining up and showing up with the hyperlinks as well. I have some other slight tweaking which I need help with. I have a macro that copies a blank time sheet. I would like to keep the blank time sheet hidden. If I hide it then the macro does not work. Is there a way to put it in this code so it works and keeps hidden. Here is the code:

Sub CopyBlankTS()
'
' CopyBlankTS Macro
' copy blank time sheet
'
' Keyboard Shortcut: Ctrl+b
'
'Static nNum
Application.ScreenUpdating = False
On Error GoTo there
For i = 1 To 1000
If Len(Sheets("TS" & i).Name) > 0 Then
GoTo here
Else
there:
shtName = "TS" & i
Exit For
End If
here:
Next
Sheets("BlankTS").Select
ActiveWindow.SelectedSheets.Visible = False
Range("A1:H76").Select
Selection.Copy
Sheets.Add after:=Sheets(Sheets.count)
ActiveSheet.Paste
ActiveSheet.Name = shtName
Application.CutCopyMode = False
ActiveSheet.Protect
Range("A1").Select
End Sub


JAM
Colin I looked at your suggestion but I have so much time into this project and some users have already seen parts of it, I was determined to get it to work. Thank you again.
 
Upvote 0
Jam,

Instead of :

Code: 
Sheets("BlankTS").Select
ActiveWindow.SelectedSheets.Visible = False
Range("A1:H76").Select
Selection.Copy
Sheets.Add after:=Sheets(Sheets.count)
ActiveSheet.Paste
ActiveSheet.Name = shtName
Application.CutCopyMode = False

Try:

Code: 
Sheets("BlankTS").Visible = -1
Sheets("BlankTS").Select
Range("A1:H76").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("BlankTS").Visible = 0

Instead of Adding a sheet & Copy & Paste, you could format the "Blank"
and just copy and insert the sheet like:

Code: 
Sheets("BlankTS")Visible = -1
Sheets("BlankTS").Select
Sheets("BlankTS").Copy After:=Sheets(Sheets.count)
ActiveSheet.Name =  shtName
Sheets("BlankTS").Visible = 0
 
Upvote 0
Hi Colin

That worked great. Thank you very much.

I have another slight tweaking. When I run the following code I want it to show up after the "cover" worksheet. Where would I put that code. I found this but I do not know where I should put it into this code. Worksheets.Add after:=Worksheets("Cover")

Sub SummarySheet()
'
' SummarySheet Macro
' Macro recorded 2/12/2009
' Create links to all sheets and show totals
'
Dim ws As Worksheet
Dim wsANm As String
Dim wsA As Worksheet
Dim r As Integer
Dim MyTot1 As Variant
Dim MyTot2 As Variant
Dim MyTot3 As Variant
Dim MyTot4 As Variant
Dim MyTot5 As Variant
'
' Cell that has the totals on each sheet
Set MyTot1 = Range("c7")
Set MyTot2 = Range("c6")
Set MyTot3 = Range("C11")
Set MyTot4 = Range("e11")
Set MyTot5 = Range("g11")
'
Set wsA = Worksheets.Add(Before:=Worksheets(1))
MyTot1 = MyTot1.Address
MyTot2 = MyTot2.Address
MyTot3 = MyTot3.Address
MyTot4 = MyTot4.Address
MyTot5 = MyTot5.Address
wsANm = wsA.Name
On Error Resume Next
wsA.Name = "Summary"
NoName: If Err.Number = 1004 Then
Application.DisplayAlerts = False
Sheets("Summary").Delete
Application.DisplayAlerts = True
wsA.Name = "Summary"
End If
If wsA.Name = wsANm Then GoTo NoName
On Error GoTo 0
'
r = wsA.Range("B65536").End(xlUp).Row + 1
wsA.Cells(r, 2).Value = "Cost Summary"
wsA.Cells(r, 2).Font.Bold = True
wsA.Cells(r + 2, 2).Value = "Worksheets"
wsA.Cells(r + 2, 2).Font.Italic = True
wsA.Cells(r + 2, 3).Value = "Date"
wsA.Cells(r + 2, 3).Font.Italic = True
wsA.Cells(r + 2, 4).Value = "Name/Location"
wsA.Cells(r + 2, 4).Font.Italic = True
wsA.Cells(r + 2, 5).Value = "Hourly Rate"
wsA.Cells(r + 2, 5).Font.Italic = True
wsA.Cells(r + 2, 6).Value = "Hours Worked"
wsA.Cells(r + 2, 6).Font.Italic = True
wsA.Cells(r + 2, 7).Value = " Shift Total"
wsA.Cells(r + 2, 7).Font.Italic = True
For Each ws In Worksheets
If ws.Index <> wsA.Index And ws.Name <> "Merged Data" And ws.Name <> "Stats" And ws.Name <> "BlankTS" And ws.Name <> "BlankChkpt" And ws.Name <> "DATES" And ws.Name <> "Holiday Costs(1)" And ws.Name <> "Holiday Stats(1)" And ws.Name <> "Holiday" And ws.Name <> "Cover" Then
r = Range("B65536").End(xlUp).Row + 1
wsA.Hyperlinks.Add Anchor:=wsA.Cells(r, 2), Address:="", _
SubAddress:=ws.Name & "!A1", TextToDisplay:=ws.Name
wsA.Cells(r, 3).Value = ws.Range(MyTot1).Value
wsA.Cells(r, 4).Value = ws.Range(MyTot2).Value
wsA.Cells(r, 5).Value = ws.Range(MyTot3).Value
wsA.Cells(r, 6).Value = ws.Range(MyTot4).Value
wsA.Cells(r, 7).Value = ws.Range(MyTot5).Value
End If
Next ws
wsA.Range("A1").Select
Columns("B:C").EntireColumn.AutoFit
'
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Daily summary worksheet that extracts data from up to 40 worksheets and emails the sheet as an excel attachment.
Replies
4
Views
552
juscuz419
J
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
121
brentcole
B
T
  • Solved
Copy worksheet to new workbook without formulas or macro button
Replies
9
Views
2K
Tgrundy09
T
M
  • Question Question
Prevent worksheet change from triggering when similar macro is executed?
Replies
1
Views
139
AlphaFrog
AlphaFrog
B
  • Question Question
Update Variable Data from Multiple Worksheets in a Master Sheet
2
Replies
11
Views
764
mumps
mumps

Forum statistics

Threads
1,224,502
Messages
6,179,126
Members
452,890
Latest member
Nikhil Ramesh

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top