D
Dan
Hi,
I am trying to modify my macro to paste the values on the first blank row of
the "Totals" worksheet but the problem I am running into is that all of the
examples I see actually "paste" the data, where I do not.
It works great the first time, copying over all the information from the
other sheets, but if I run it a 2nd time, then it just copies right over the
original. I tried experimenting with a dynamic offset (instead of 0, X), but
I cannot get that to work.
Any help would be really appreciated! Thank you!
-Dan
-------------------------------------------------------------
Sub Starting()
Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range
Dim rDate As Range
Dim rHours As Range
Dim LastRow As Long
Dim HowManyRows As Long
Set rDest = ActiveWorkbook.Worksheets("Totals").Range("C5")
Set rDate = ActiveWorkbook.Worksheets("Totals").Range("B2")
Set rHours = ActiveWorkbook.Worksheets("Totals").Range("E5")
For Each ws In ActiveWorkbook.Worksheets
'Define worksheets to loop through
If ws.Name = "Kristine" Or _
ws.Name = "Toby" Or _
ws.Name = "Carl" Or _
ws.Name = "Tamara" Or _
ws.Name = "Melanie" Or _
ws.Name = "Amy" Or _
ws.Name = "Dan" Then
With ws
If IsEmpty(.Range("A46").Value) = False Then
LastRow = 46
Else
LastRow = .Range("A46").End(xlUp).Row
End If
HowManyRows = LastRow - 6 + 1
End With
'Paste date
rDest.Offset(0, -1).Resize(HowManyRows).Value = rDate.Value
'Paste worksheet name (person)
rDest.Offset(0, -2).Resize(HowManyRows).Value = ws.Name
'Paste activity and category
With ws.Range("A6:B" & LastRow)
rDest.Resize(.Rows.Count, .Columns.Count).Value = .Value
Set rDest = rDest.Offset(.Rows.Count, 0)
End With
'Paste hours
With ws.Range("I6:I" & LastRow)
rHours.Resize(.Rows.Count, .Columns.Count).Value = .Value
Set rHours = rHours.Offset(.Rows.Count, 0)
End With
End If
Next ws
End Sub
I am trying to modify my macro to paste the values on the first blank row of
the "Totals" worksheet but the problem I am running into is that all of the
examples I see actually "paste" the data, where I do not.
It works great the first time, copying over all the information from the
other sheets, but if I run it a 2nd time, then it just copies right over the
original. I tried experimenting with a dynamic offset (instead of 0, X), but
I cannot get that to work.
Any help would be really appreciated! Thank you!
-Dan
-------------------------------------------------------------
Sub Starting()
Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range
Dim rDate As Range
Dim rHours As Range
Dim LastRow As Long
Dim HowManyRows As Long
Set rDest = ActiveWorkbook.Worksheets("Totals").Range("C5")
Set rDate = ActiveWorkbook.Worksheets("Totals").Range("B2")
Set rHours = ActiveWorkbook.Worksheets("Totals").Range("E5")
For Each ws In ActiveWorkbook.Worksheets
'Define worksheets to loop through
If ws.Name = "Kristine" Or _
ws.Name = "Toby" Or _
ws.Name = "Carl" Or _
ws.Name = "Tamara" Or _
ws.Name = "Melanie" Or _
ws.Name = "Amy" Or _
ws.Name = "Dan" Then
With ws
If IsEmpty(.Range("A46").Value) = False Then
LastRow = 46
Else
LastRow = .Range("A46").End(xlUp).Row
End If
HowManyRows = LastRow - 6 + 1
End With
'Paste date
rDest.Offset(0, -1).Resize(HowManyRows).Value = rDate.Value
'Paste worksheet name (person)
rDest.Offset(0, -2).Resize(HowManyRows).Value = ws.Name
'Paste activity and category
With ws.Range("A6:B" & LastRow)
rDest.Resize(.Rows.Count, .Columns.Count).Value = .Value
Set rDest = rDest.Offset(.Rows.Count, 0)
End With
'Paste hours
With ws.Range("I6:I" & LastRow)
rHours.Resize(.Rows.Count, .Columns.Count).Value = .Value
Set rHours = rHours.Offset(.Rows.Count, 0)
End With
End If
Next ws
End Sub