No more errors - but now the macro seems to be copying almost the entire
sheet instead of just the rows between 6-46 with text in column A. I see
where it is doing it but I am not sure how to fix it at this point.



"Dave Peterson" wrote:

Typing error!!!!!

change:
Dim LastRow As Range
to
Dim LastRow As Long

Dan wrote:

Hi Dave,

Thanks for your help. I am getting a Run-time error 91 at "LastRow =
.Cells(.Rows.Count, "A").End(xlUp).Row". It is saying "Object variable or
With block variable not set" - do you know what could be causing that?

Thanks!
-Dan

"Dave Peterson" wrote:

ps. This wasn't tested and wasn't compiled.

Dave Peterson wrote:

Maybe...

Option Explicit
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 Range
Dim HowManyRows As Long

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
'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
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
HowManyRows = LastRow - 6 + 1
End With

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

'Paste date
With ws.Range("B2:b" & LastRow)
rDate.Resize(.Rows.Count, .Columns.Count).Value = .Value
Set rDate = rDate.Offset(.Rows.Count, 0)
End With

'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 used column A to determine the last row to copy.

Dan wrote:

Hi,

I am trying to alter the following macro to change the number of rows that
it copies from 1 to a variable number based on what rows have data. Right now
it copies and pastes Rows A, B, and I for row 6. I would like to have it copy
and paste those same values but for all rows that contain data from Row 6-46.

Does anyone know how to make that happen? I have been trying a lot of
different things and searching but nothing seems to be working quite
correctly. I am so close to getting it to work now.

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 = "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

'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

--

Dave Peterson

--

Dave Peterson


--

Dave Peterson