Solved: Loop through and Copy

[Odyrus]

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]

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]

Same song, different melody:[vba]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[/vba]

[Odyrus]

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]

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:

[VBA]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[/VBA]

cheers!

[GTO]

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]

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]

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]

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

[GTO]

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]

Ah... that makes total sense now! Thanks for the help!

Cheers!