D
Dan
I posted this a couple weeks ago but got no response and figured it might
have been lost in the shuffle.
I have 7 sheets in my workbook (6 individuals and 1 summary) and I am
looking to create a macro that will loop through all the individual sheets,
copying cells values to the total sheet. It is a little more complicated as
you will see, but a lot of it is working already.
Right now I am having some trouble though:
1) On the individual worksheets, it only grabs one row, even if there are
multiple ones filled. I would ideally like it to start at A6, and then loop
through, copying from every row until it hits a blank row. Then move onto the
next worksheet.
2) When pasting on the "Totals" worksheet, I would like it to look for the
first blank row after row 5 and then start pasting there. Right now if I run
the macro twice, it will just overwrite whatever it put there the first time.
Any help would be appreciated!
My code so far is below. Thanks!
-Dan
---------------------------------------------------
Sub Starting()
Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range
Dim rDate As Range
Dim rHours As Range
Set rDest = ActiveWorkbook.Worksheets("Totals").Range("C5")
Set rDate = ActiveWorkbook.Worksheets("Totals").Range("B5")
Set rHours = ActiveWorkbook.Worksheets("Totals").Range("E5")
For Each ws In ActiveWorkbook.Worksheets
'Defind worksheets to loop through
If ws.Name = "Toby" Or _
ws.Name = "Kristine" Or _
ws.Name = "Carl" Or _
ws.Name = "Amy" Or _
ws.Name = "Dan" Or _
ws.Name = "Tamara" Then
'Paste worksheet name
rDest.Offset(0, -2).Value = ws.Name
'Paste date
With ws.Range("B2")
rDate.Resize(1, .Columns.Count).Value = .Value
End With
Set rDate = rDate.Offset(1, 0)
'Paste activity and category
With ws.Range("A6:B6")
rDest.Resize(1, .Columns.Count).Value = .Value
End With
Set rDest = rDest.Offset(1, 0)
'Paste hours
With ws.Range("I6")
rHours.Resize(1, .Columns.Count).Value = .Value
End With
Set rHours = rHours.Offset(1, 0)
End If
Next ws
End Sub
have been lost in the shuffle.
I have 7 sheets in my workbook (6 individuals and 1 summary) and I am
looking to create a macro that will loop through all the individual sheets,
copying cells values to the total sheet. It is a little more complicated as
you will see, but a lot of it is working already.
Right now I am having some trouble though:
1) On the individual worksheets, it only grabs one row, even if there are
multiple ones filled. I would ideally like it to start at A6, and then loop
through, copying from every row until it hits a blank row. Then move onto the
next worksheet.
2) When pasting on the "Totals" worksheet, I would like it to look for the
first blank row after row 5 and then start pasting there. Right now if I run
the macro twice, it will just overwrite whatever it put there the first time.
Any help would be appreciated!
My code so far is below. Thanks!
-Dan
---------------------------------------------------
Sub Starting()
Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range
Dim rDate As Range
Dim rHours As Range
Set rDest = ActiveWorkbook.Worksheets("Totals").Range("C5")
Set rDate = ActiveWorkbook.Worksheets("Totals").Range("B5")
Set rHours = ActiveWorkbook.Worksheets("Totals").Range("E5")
For Each ws In ActiveWorkbook.Worksheets
'Defind worksheets to loop through
If ws.Name = "Toby" Or _
ws.Name = "Kristine" Or _
ws.Name = "Carl" Or _
ws.Name = "Amy" Or _
ws.Name = "Dan" Or _
ws.Name = "Tamara" Then
'Paste worksheet name
rDest.Offset(0, -2).Value = ws.Name
'Paste date
With ws.Range("B2")
rDate.Resize(1, .Columns.Count).Value = .Value
End With
Set rDate = rDate.Offset(1, 0)
'Paste activity and category
With ws.Range("A6:B6")
rDest.Resize(1, .Columns.Count).Value = .Value
End With
Set rDest = rDest.Offset(1, 0)
'Paste hours
With ws.Range("I6")
rHours.Resize(1, .Columns.Count).Value = .Value
End With
Set rHours = rHours.Offset(1, 0)
End If
Next ws
End Sub