首页 > 解决方案 > For 循环工作簿中的工作表 - 工作表名称等于单元格范围 - Excel VBA

问题描述

For 循环工作簿中的工作表 - 工作表名称等于单元格范围

我正在尝试编写一个脚本来将一系列数据从一个工作簿复制并粘贴到另一个工作簿。我的代码当前没有循环并且在复制单个工作表时。

我正在寻找有关 For Loop 部分的一些指导(第一次使用)。表格“名称”只是代码将循环遍历的数字范围。表 1 = 1,表 2 = 2 ...。表 31 = 31

我想要由特定单元格值指定的循环数。例如,如果单元格“B3” = 4 并且单元格“C3” = 15,我希望代码为工作表 4 到工作表 15 运行 for 循环。

我的 2 个问题是:如何将代码插入 For 循环/使用哪种 For 循环?&我如何使用 Sheet( ).select 括号内等于单元格值的位置。(下面代码中的粗体)

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

标签: excelvbaloopsfor-loop

解决方案


按索引循环工作表

这是一个开始:

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

推荐阅读