Loop Through Workbooks names in Cell range B3-B21

Question

I have vba code that opens a sheet within a workbook and copies a certain range to the same sheet. code below, how do I create a loop, instead of copying the code over and over changing cell references. instead open sheet in B3 copy, open b4 copy etc until B27? I've looked around but it might be the search terms I'm using can't find a resolution so far,

Worksheets(Worksheets("Contents").Range("B3").Value).Activate Range("B2").Select

to go to the next sheet I would manually change B3 to b4, how can I create a loop to do this for a defined Bx range?

full code being executed below

`Worksheets(Worksheets("Contents").Range("B3").Value).Activate
Range("B2").Select
Count rows in raw data

intRowsused = ActiveSheet.UsedRange.Rows.Count 'count rows used in the table

'Copy

Range("B3:T" & intRowsused).Copy

Sheets("Master Template").Select

Set rng = ActiveSheet.Range("A:T")

    lastRow = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

writeRow = lastRow + 1

Range("A" & writeRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False `

any help will be much appreciated. Thanks

I have a couple of questions with answers that show code that does what you ask - have a look... — Solar Mike, Mar 03 '20 at 14:43

score 0 · Accepted Answer · answered Mar 03 '20 at 14:52

0

You can edit your code to include a "For" loop. I would just replace all of your references to B3 with "B & i".

dim i as long
for i = 3 to 27
'edit code to include "i" instead of 3, 4 , 5 through 27

Range("B" & i & ":T" & intRowsused).Copy

Next i

answered Mar 03 '20 at 14:52

roses56

130
9

Hi, thanks for getting back to me - not sure what i'm entering wrong, the below is the part of the code i've amended to loop through the work sheets with your suggestion. It's working through the sheets in a strange order & not copying all `Worksheets(Worksheets("Contents").Range("B" & i).Value).Activate Range("B2").Select` Variables 'Dim lngReportRowsUsed As Long Dim lastRow As Long Dim writeRow As Long Dim rng As Range Dim targetSheetName As String Dim targetSheetFound As Boolean Dim sheet As Worksheet Dim i As Long For i = 2 To 27` – T_M_ Mar 03 '20 at 15:28
Please [edit your question](https://stackoverflow.com/posts/60509547/edit) instead of adding lengthy code in comments. Side note, try to [avoid using select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code – cybernetic.nomad Mar 03 '20 at 15:52
Solved it, using your recomendation, I hadnt deleted certain aspects of the code out, that stopped the loop. thanks again - much appreciated. Saved me a Task!! – T_M_ Mar 03 '20 at 15:54
Glad you were able to do it! – roses56 Mar 03 '20 at 16:34

score 0 · Answer 2 · answered Mar 03 '20 at 16:01

This is how you can avoid using select

Option Explicit 
Sub CopyToMaster()

    Dim wb As Workbook
    Dim wsContents As Worksheet, wsSource As Worksheet, wsTarget As Worksheet
    Dim rngSource As Range, rngTarget As Range, cell As Range
    Dim targetRow As Long

    Set wb = ActiveWorkbook ' or thisworkbook
    Set wsTarget = wb.Sheets("Master Template")
    Set wsContents = wb.Sheets("Contents")

    targetRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

    For Each cell In wsContents.Range("B3:B5")
        Set wsSource = wb.Sheets(cell.Value)

        Set rngSource = wsSource.Range("B3:T" & wsSource.UsedRange.Rows.Count)
        rngSource.Copy

        Set rngTarget = wsTarget.Range("A" & targetRow)
        rngTarget.PasteSpecial Paste:=xlPasteValues

        targetRow = targetRow + rngSource.Rows.Count
    Next

    MsgBox "Copy complete", vbInformation
End Sub

Loop Through Workbooks names in Cell range B3-B21

2 Answers2