1

For Loop through sheets in a workbook – sheet names equal to a cell range

I am trying to write a script to copy and paste a range of data from one workbook to another. My code currently without the loop and when a single sheet is copied.

I am looking for some guidance on the For Loop portion (first time ever using one). The sheets “names” are just a range of numbers in which the code will loop through. Sheet 1 = 1, sheet 2 = 2 …. Sheet 31 = 31

I want the number of loops, to be ran, specified by specific cell values. For example If cell “B3” = 4 and cell “C3” = 15 I would like the code to run a for loop for Sheets 4 through sheet 15.

My 2 questions are: How do I insert my code into a For loop / which kind of For loop to use? & How do I use Sheet( ).select where the inside of the parenthesis is equal to a cell value. (Bold in the code below)

Sub refresh()

Windows("Truck Racks RawData.xlsm").Activate
Sheets("Refresh Data").Select

Dim X As Integer
For X = Range("B3") To Range("C3")

    Windows("Truck Log-East Gate-January.xlsx").Activate

    Sheets(**"X"**).Select

    Sheets(**"X"**).Range("A4:R4").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Windows("Truck Racks RawData.xlsm").Activate
    Sheets("RawDataMacro").Select

    Range("A" & Rows.Count).End(xlUp).Select ' starts from the bottom of the worksheet and finds the last cell with data

    ActiveCell.Offset(1).Select ' moves cursor down one cell

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Next X


End Sub
CMB
  • 4,950
  • 1
  • 4
  • 16
Ross.P
  • 31
  • 3
  • 2
    Question 1: https://stackoverflow.com/questions/25953916/excel-vba-looping-through-multiple-worksheets Question 2: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – sous2817 Jan 26 '21 at 15:52
  • In which workbook is the code located? `Truck Racks RawData.xlsm`, `Truck Log-East Gate-January.xlsx` or a third workbook? – VBasic2008 Jan 26 '21 at 16:18
  • Truck Racks RawData.xlsm – Ross.P Jan 26 '21 at 16:36

1 Answers1

1

Loop Through Worksheets by Index

Here's a start:

Option Explicit

Sub refreshData()
    
    ' Destination Write
    Const dwsName As String = "RawDataMacro"
    Const dCol As String = "A"
    ' Destination Read (Indexes)
    Const dwsiName As String = "Refresh Data"
    Const diFirst As String = "B3"
    Const diLast As String = "C3"
    ' Source
    Const swbName As String = "Truck Log-East Gate-January.xlsx"
    Const srcAddress As String = "A4:R4"
    
    ' Define Destination Workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    ' Define Destination Write Worksheet.
    Dim dst As Worksheet: Set dst = wb.Worksheets(dwsName)
    ' Define the first available cell in column dCol ('A').
    Dim dCel As Range
    Set dCel = dst.Cells(dst.Rows.Count, dCol).End(xlUp).Offset(1)
    
    ' Define Destination Read Worksheet.
    Dim dsti As Worksheet: Set dsti = wb.Worksheets(dwsiName)
    
    ' Define Source Workbook.
    Dim swb As Workbook: Set swb = Workbooks(swbName)
    
    ' Declare additional variables.
    Dim src As Worksheet ' Source Worksheet
    Dim srng As Range ' Source Range
    Dim n As Long ' Source Worksheet Index Counter
    
    ' Write data from each Source Worksheet to Destination Worksheet.
    For n = dsti.Range(diFirst).Value To dsti.Range(diLast).Value
        ' Define current Source Worksheet.
        Set src = swb.Worksheets(n)
        ' Define current Source Range.
        Set srng = defineColumnsRange(src.Range(srcAddress))
        ' Write values.
        dCel.Resize(srng.Rows.Count, srng.Columns.Count).Value = srng.Value
        ' Create offset.
        Set dCel = dCel.Offset(srng.Rows.Count)
    Next n

End Sub

Function defineColumnsRange( _
    FirstRowRange As Range) _
As Range
    On Error GoTo clearError
    If FirstRowRange Is Nothing Then GoTo ProcExit
    With FirstRowRange
        Dim cel As Range: Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If cel Is Nothing Then GoTo ProcExit
        Set defineColumnsRange = .Resize(cel.Row - .Row + 1)
    End With
ProcExit:
    Exit Function
clearError:
    Resume ProcExit
End Function
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • Thanks! When step through the code line by line it looks like it runs fine, but on the second loop I get a runtime error at dCel.Rezize with no data being copied over. I get the jist of what you wrote so ill keep playing with it in the meantime. thanks for the start – Ross.P Jan 26 '21 at 18:22
  • The Code works at copying the data from source worksheet to the destination worksheet. However, it stops after the 1st loop. The code also seems to only be copying data from whatever is the last worksheet on the source workbook, in this case sheet 31. It seems to be skipping over the defined sheet range from in cells B3 and C3. Ill keep playing with it and give an update once i figure it out. – Ross.P Jan 26 '21 at 22:07
  • I've made some improvements. Defining of the Source Ranges looked a little bit suspicious. I understood you have numbers in cells `B3` and `C3`, e.g. `3` and `5` would mean either copy ranges from `swb.Worksheets(3), swb.Worksheets(4) and swb.Worksheets(5)` or is it `swb.Worksheets("Sheet3"), swb.Worksheets("Sheet4") and swb.Worksheets("Sheet5")`. Are you using `n` or `Sheet & n`? Or did I misunderstand. – VBasic2008 Jan 26 '21 at 23:00
  • using just "N". If B3 and C3 are 3 and 5, it would copy ranges from 3, 4, and 5 – Ross.P Jan 27 '21 at 13:30