Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complex copy and paste looping VBA help
Hi,
I have been searching a lot for what I want to do and so far can do some of the individual components, but am not sure how to put it all together. I will try to explain what I am trying to do as best as I can. Please let me know if it is confusing. -Workbook has 7 sheets (6 individual and 1 summary sheet) I am trying to write a macro which will: -Loop through all individual sheets, copying cell values to the Totals sheet -Perform these actions on each individual sheet: --Locate every row where Column I contains a number 0 --Copy values from that row in Columns A, B, I --Go to first blank row in Totals sheet (there should be no gaps if using Column B to look for values) --Paste values using the following mapping: Individual!B1 should always be Totals column A, Individual!B2 should always be Totals column B, Individual A - Totals C, Individual B - Totals D, Individual I - Totals E --Repeat for every row in Individual that has data in Column A between rows 6 and the first gap -Loop through all six individual sheets (named Toby, Kristine, Carl, Amy, Dan, Tamara), performing the actions above and always copy the cell values to the first blank row in Totals, starting at Row 5. I know this is a huge project and I have probably not explained it very well but I would really appreciate any help anyone could offer me. I can provide screen shots, or the file if that would help anyone. Thank you! -Dan |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complex copy and paste looping VBA help
This code WON'T do everything that you want, but should get you started in
the right direction: Dim ws As Worksheet Dim rCopy As Range Dim rDest As Range Set rDest = ActiveWorkbook.Worksheets("Summary").Range("B3") For Each ws In ActiveWorkbook.Worksheets If ws.Name < "Summary" Then rDest.Offset(0, -1).Value = ws.Name With ws.Range("B39:T39") '< -- change range... rDest.Resize(1, .Columns.Count).Value = .Value End With Set rDest = rDest.Offset(1, 0) End If Next ws Change the ranges to suit your needs. Regards, Ryan--- -- RyGuy "Dan" wrote: Hi, I have been searching a lot for what I want to do and so far can do some of the individual components, but am not sure how to put it all together. I will try to explain what I am trying to do as best as I can. Please let me know if it is confusing. -Workbook has 7 sheets (6 individual and 1 summary sheet) I am trying to write a macro which will: -Loop through all individual sheets, copying cell values to the Totals sheet -Perform these actions on each individual sheet: --Locate every row where Column I contains a number 0 --Copy values from that row in Columns A, B, I --Go to first blank row in Totals sheet (there should be no gaps if using Column B to look for values) --Paste values using the following mapping: Individual!B1 should always be Totals column A, Individual!B2 should always be Totals column B, Individual A - Totals C, Individual B - Totals D, Individual I - Totals E --Repeat for every row in Individual that has data in Column A between rows 6 and the first gap -Loop through all six individual sheets (named Toby, Kristine, Carl, Amy, Dan, Tamara), performing the actions above and always copy the cell values to the first blank row in Totals, starting at Row 5. I know this is a huge project and I have probably not explained it very well but I would really appreciate any help anyone could offer me. I can provide screen shots, or the file if that would help anyone. Thank you! -Dan |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complex copy and paste looping VBA help
Hi Ryan,
Thanks for your help. It was a great start and it works good right now. I'm just having a couple problems I'm hoping you can help me with (my code is below): 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. Thank you! -Dan "ryguy7272" wrote: This code WON'T do everything that you want, but should get you started in the right direction: Dim ws As Worksheet Dim rCopy As Range Dim rDest As Range Set rDest = ActiveWorkbook.Worksheets("Summary").Range("B3") For Each ws In ActiveWorkbook.Worksheets If ws.Name < "Summary" Then rDest.Offset(0, -1).Value = ws.Name With ws.Range("B39:T39") '< -- change range... rDest.Resize(1, .Columns.Count).Value = .Value End With Set rDest = rDest.Offset(1, 0) End If Next ws Change the ranges to suit your needs. Regards, Ryan--- -- RyGuy "Dan" wrote: Hi, I have been searching a lot for what I want to do and so far can do some of the individual components, but am not sure how to put it all together. I will try to explain what I am trying to do as best as I can. Please let me know if it is confusing. -Workbook has 7 sheets (6 individual and 1 summary sheet) I am trying to write a macro which will: -Loop through all individual sheets, copying cell values to the Totals sheet -Perform these actions on each individual sheet: --Locate every row where Column I contains a number 0 --Copy values from that row in Columns A, B, I --Go to first blank row in Totals sheet (there should be no gaps if using Column B to look for values) --Paste values using the following mapping: Individual!B1 should always be Totals column A, Individual!B2 should always be Totals column B, Individual A - Totals C, Individual B - Totals D, Individual I - Totals E --Repeat for every row in Individual that has data in Column A between rows 6 and the first gap -Loop through all six individual sheets (named Toby, Kristine, Carl, Amy, Dan, Tamara), performing the actions above and always copy the cell values to the first blank row in Totals, starting at Row 5. I know this is a huge project and I have probably not explained it very well but I would really appreciate any help anyone could offer me. I can provide screen shots, or the file if that would help anyone. Thank you! -Dan |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complex copy and paste looping VBA help
Sorry - forgot to attach my code so far:
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complex copy and paste looping VBA help
Hi Ryan,
Is there any chance you could take a look at my code above? Thanks, -Dan "Dan" wrote: Sorry - forgot to attach my code so far: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Complex Copy/Paste HELP.... | Excel Programming | |||
Complex Copy/Paste help | Excel Programming | |||
Complex Copy/Paste help | Excel Programming | |||
complex copy and paste | Excel Programming | |||
Copy-Paste while looping | Excel Programming |