PDA

View Full Version : Solved: Loop through and Copy



Odyrus
05-09-2011, 07:32 AM
Hello all!

First I'd to thank all of you for this forum, there's a lot of great information here! Thanks!

I'm some what of a VB novice but I've learned a lot by reading through code and playing with things. One thing I'm having trouble with is creating some code that loops through all the sheets in my workbook, except for sheets 1 and 2, and copies a specific range, BO45, from all of them to my roll up sheet ("rollup").

Any thoughts?

I appreciate any assistance!

GTO
05-09-2011, 07:57 AM
Greetings Odyrus,

Welcome to vbaexpress :-)

I wasn't sure, but guessed that 'Rollup' would also be discluded.


Option Explicit

Sub exa2()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If Not (wks.Name = "Rollup" Or wks.Name = "Sheet1" Or wks.Name = "Sheet2") Then
ThisWorkbook.Worksheets("Rollup").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value _
= wks.Range("BO45").Value
End If
Next
End Sub
Hope that helps,

Mark

ntrauger
05-09-2011, 08:00 AM
Same song, different melody:Sub a()
Dim iCount As Long
Dim rDest As Range
If Sheets.Count < 3 Then Exit Sub 'Pre-emptive error checking
Set rDest = Sheets("rollup").Range("A1") 'Preset destination cell of copy method
For iCount = 3 To Sheets.Count 'Loop through all sheets except the first 2
If Sheets(iCount).Name <> "rollup" Then 'Assuming "rollup" sheet should be excluded _
' and may not be among first 2 sheets
Sheets(iCount).Range("BO45").Copy rDest 'Copy to preset cell on "rollup" sheet
Set rDest = rDest.Offset(1) 'Move destination cell one row down
End If
Next
End Sub

Odyrus
05-09-2011, 08:22 AM
I've noticed there is usually more than one way to a skin a cat when it comes to programming something in VB. Cheers!

Odyrus
05-18-2011, 07:39 AM
Hello again,

The code provided proved to be very helpful, thanks. I'm trying to revise it to include more than one value into the corresponding range on my rollup with out any luck. (Kind of like concatenating).

Appreciate any feedback.

Here's the code I'm not having luck with:

For Each wks In ThisWorkbook.Worksheets
If Not (wks.Name = "Rollup" Or wks.Name = "Sheet1" Or wks.Name = "Sheet2") Then
ThisWorkbook.Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value _
= wks.Range("K49" & "K50").Value

cheers!

GTO
05-20-2011, 06:00 AM
Hi there,

No testing, but I believe that this would solve.

For Each wks In ThisWorkbook.Worksheets
If Not (wks.Name = "Rollup" Or wks.Name = "Sheet1" Or wks.Name = "Sheet2") Then
ThisWorkbook.Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(2).Value _
= wks.Range("K49:K50").Value
Note the difference in the argument supplied to .Range, and that we need to .Resize the destination cells, as you are now grabbing two cells.

Odyrus
05-20-2011, 06:09 AM
Hey GTO, thanks for the response!

I didn't think to resize the destination cells, good call.

However, I did try listing the range as your solution states (K49:K50) and in both cases (K49:K50 and K49 & K50) I'm still getting just the value for K49.

I added the resize component to the code and I'm still just getting one value. It's a conundrum for me for sure!

Thoughts?
Cheers!

GTO
05-20-2011, 06:20 AM
I just tested this exact code in a Standard Module and it works.

Option Explicit

Sub exa()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If Not (wks.Name = "Rollup" Or wks.Name = "Sheet1" Or wks.Name = "Sheet2") Then
ThisWorkbook.Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(2).Value _
= wks.Range("K49:K50").Value
End If
Next
End Sub

Odyrus
05-20-2011, 06:29 AM
It does work, gratitude!

One question though, is it not possible to copy those contents into the same cell like concatenate?

Thanks for the assistance
:thumb

GTO
05-20-2011, 08:13 AM
Sorry, I misunderstood that part. Okay, no resizing if its going in one cell from two...

Sub exa()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If Not (wks.Name = "Rollup" Or wks.Name = "Sheet1" Or wks.Name = "Sheet2") Then
ThisWorkbook.Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value _
= wks.Range("K49").Value & Chr(32) & wks.Range("K50").Value
End If
Next
End Sub

Odyrus
05-20-2011, 11:15 AM
Ah... that makes total sense now! Thanks for the help!

Cheers!