Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
241 views
in Technique[技术] by (71.8m points)

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

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
question from:https://stackoverflow.com/questions/65904473/for-loop-through-sheets-in-a-workbook-sheet-names-equal-to-a-cell-range-exce

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...