Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Change macro to copy variable amount of rows instead of just 1?
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
dan dan is offline
external usenet poster
  
Posts: 866
Default Change macro to copy variable amount of rows instead of just 1?
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Change macro to copy variable amount of rows instead of just 1?
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
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Change macro to copy variable amount of rows instead of just 1?
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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
dan dan is offline
external usenet poster
  
Posts: 866
Default Change macro to copy variable amount of rows instead of just 1
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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 35,218
Default Change macro to copy variable amount of rows instead of just 1
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
Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
dan dan is offline
external usenet poster
  
Posts: 866
Default Change macro to copy variable amount of rows instead of just 1
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

Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 947
Default Change macro to copy variable amount of rows instead of just 1
If ws.Name = "Kristine" Or _

ws.Name = "Toby" Or _
ws.Name = "Carl" Or _
ws.Name = "Tamara" Or _ etc...


Hi. I see you have an excellent solution. Using Select Case might be another option to use.

Select Case ws.Name
Case "Amy", "Carl", "Dan", "Kristine", "Melanie", "Tamara", "Toby"
'Do Stuff
'etc
End Select

--
Dana DeLouis

<snip
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

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


All times are GMT +1. The time now is 03:01 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement