About Us

dan

Thanks for that catch.

"Dave Peterson" wrote:

Glad you got it working.

But there seems to be a minor mismatch (unimportant to the code--maybe confusing
to a human):

'Paste worksheet name (person)
rDest.Offset(0, -1).Resize(HowManyRows).Value = rDate.Value

'Paste date
rDest.Offset(0, -2).Resize(HowManyRows).Value = ws.Name

It looks like the comments are reversed.

Dan wrote:

I was actually able to get it work. My code is below incase it helps anyone
else.

There are just 2 more things, Dave, that is see now - but they are outside
the scope of my original question so I understand if you can't help me with
them:

1) If a sheet contains no data, the macro fails.

2) If I run the macro a 2nd time, it just replaces all of my first data on
the Totals sheet. Is there a way to have it copy the next "run" on the first
blank row below the data?

Thanks again for all your help - this is great!

-------------------------------------------------------------

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 worksheet name (person)
rDest.Offset(0, -1).Resize(HowManyRows).Value = rDate.Value

'Paste date
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

--

Dave Peterson

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copy/Paste Macro using large amount of Data	Nikki	Excel Discussion (Misc queries)	2	December 10th 08 03:12 PM
How to change the amount of rows that is effected when scrolling.	Tobias	Excel Worksheet Functions	2	December 27th 07 04:06 PM
How to change amount in figure to amount in words?	Lotis	Excel Worksheet Functions	3	June 27th 07 04:34 AM
How to Create a Macro to Edit a Variable Amount of Information	Matt	New Users to Excel	4	August 12th 06 10:05 PM
change the number of rows to a variable	minrufeng[_6_]	Excel Programming	2	August 15th 05 10:03 PM

Menu

About Us