首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >如何让我的VBA代码遍历工作簿中的所有工作表?

如何让我的VBA代码遍历工作簿中的所有工作表?
EN

Stack Overflow用户
提问于 2019-03-28 06:21:31
回答 6查看 591关注 0票数 1

我的工作簿中有5个工作表(表1、表2、表3、表4及其组合)。主工作表是我试图将其他4个合并到一起,并将数据放在下一个空行中的工作表。

几周来,我一直在谷歌上搜索不同的代码解决方案,但都无济于事。

当我单步执行宏并使用循环(do while、for和Each)时,它只是完美地遍历了表1。但是我不能让它在表2-4中循环。

我想我知道我的问题在哪里,但在我几周的谷歌搜索中,我仍然找不到解决方案。我想问题出在"Sheets("Table 1").Select“这一行。因为代码似乎会一直工作,直到它到达这一行。然后“当然”返回到表1。

这是一个更大项目的测试组。我必须从500个文档中提取信息,这些文档都设置在完全相同的位置,但我必须首先让这4个文档正常工作。

“我试过了:

代码语言:javascript
复制
Dim iSheet As Object

For Each iSheet In ThisWorkbook.Sheets
    MsgBox iSheet.Name
    Next iSheet

“我试着这样做:

代码语言:javascript
复制
Dim useWorkSheet As Worksheet
Dim totalWorkSheet As Worksheet
Dim tableAsNumeric As Integer
Dim startingTable As Integer

'For Each Current In Worksheets
'Table Name = Table in Worksheets

startingTable = 1

Set totalWorkSheet = ActiveWorkbook.Sheets("Table 1")

For Each useWorkSheet In ActiveWorkbook.Worksheets
    tableAsNumeric = Val(useWorkSheet.Name)

    'If tableAsNumeric >= startingTable Then

'Do While I >= Worksheet("Table 1")
'I = I + 1

“我还尝试了一个for循环,以及网络上所有其他的循环……都不起作用……

这是我需要帮助的代码:

代码语言:javascript
复制
Sub TFRdataExtract()
'
' TFRdataExtract Macro
' Extract Data from Individual TFR files to the combined file.
'
' Keyboard Shortcut: Ctrl+e
'

Dim iSheet As Object

For Each iSheet In ThisWorkbook.Sheets
    MsgBox iSheet.Name

    Sheets("Table 1").Select
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-27], 7,100)"
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-24], 14,100)"
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-19],23,100)"
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-10],22,100)"
    Range("AF1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
    Range("AG1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[1]C[-16], 10,100)"
    Range("AH1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[1]C[-13],13,100)"
    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[2]C[-34],22,100)"
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[2]C[-25],18,100)"
    Range("AK1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[2]C[-16],21,100)"
    Range("AL1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[3]C[-37],21,100)"
    Range("AM1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[3]C[-28],17, 100)"
    Range("AN1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[3]C[-21],34,100)"
    Range("AO1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-40],28,100)"
    Range("AP1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-35], 7,100)"
    Range("AQ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-34],10,100)"
    Range("AR1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-29],10,100)"
    Range("AS1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-21],22,100)"
    Range("AT1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[5]C[-45],26,100)"
    Range("AU1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[6]C[-46],18,100)"
    Range("AV1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[6]C[-37],55,100)"
    Range("AW1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[7]C[-48],36,100)"
    Range("AX1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[7]C[-39],30,100)"
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[7]C[-28],12,100)"
    Range("AZ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[8]C[-51],20,100)"
    Range("BA1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[8]C[-35],12,100)"
    Range("BB1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[8]C[-31],20,100)"
    Range("BC1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[9]C[-54],25,100)"
    Range("BD1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[9]C[-45],15,100)"
    Range("BE1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[9]C[-39],23,100)"
    Range("BF1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-57],17,100)"
    Range("BG1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-56],17,100)"
    Range("BH1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-52],13,100)"
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-42],14,100)"
    Range("BJ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-38],15,100)"
    Range("BK1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],11,100)"
    Range("BL1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],12,100)"
    Range("BM1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-59],10,100)"
    Range("BN1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-57], 7,100)"
    Range("BO1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],7,100)"
    Range("BP1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],11,100)"
    Range("BQ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-53],12,100)"
    Range("BR1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-50],8,100)"
    Range("BS1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-47],12,100)"
    Range("BT1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],10,100)"
    Range("BU1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],20,100)"
    Range("BV1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-66],10,100)"
    Range("BW1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-63],10,100)"
    Range("BX1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-62],8,100)"
    Range("BY1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-61],7,100)"
    Range("BZ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-59],9,100)"
    Range("CA1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-57],10,100)"
    Range("CB1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-55],13,100)"
    Range("CC1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],12,100)"
    Range("CD1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],13,100)"
    Range("CE1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("CE1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-77],15,100)"
    Range("CF1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-72],7,100)"
    Range("CG1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-71],13,100)"
    Range("CH1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-67],14,100)"
    Range("CI1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-62],7,100)"
    Range("CJ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-87],13,100)"
    Range("CK1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-85],15,100)"
    Range("CL1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-82],11,100)"
    Range("CM1").Select
    ActiveCell.FormulaR1C1 = "L16,11,100)"
    Range("CN1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-73],15,100)"
    Range("CO1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-68],8,100)"
    Range("CP1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[17]C[-93],19,100)"
    Range("CQ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[17]C[-80],22,100)"
    Range("CR1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[18]C[-95],27,100)"
    Range("CS1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[18]C[-82],18,100)"
    Range("CT1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[19]C[-97],45,100)"
    Range("CU1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[19]C[-89],22,100)"
    Range("CV1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[19]C[-81],49,100)"
    Range("CW1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[20]C[-91],21,100)"
    Range("CX1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[21]C[-101],16,100)"
    Range("CY1").Select
    ActiveCell.FormulaR1C1 = "=MID(22,27,100)"
    Range("CZ1").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("CY1").Select
    ActiveWindow.SmallScroll ToRight:=-50
    Range("AB1:CY1").Select
    Range("CY1").Activate
    Selection.Copy
    Sheets("Combined").Select
    Rows("2:2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Next iSheet

End Sub

我需要遍历所有4个工作表,并将数据粘贴到组合文件中的下一个空行。

EN

回答 6

Stack Overflow用户

发布于 2019-03-28 06:26:25

试试这个:

代码语言:javascript
复制
For sht = 1 To Sheets.Count
    Debug.Print sht
    'your code here
    Sheets(sht).Activate'or
    Sheets(Sheets(sht).Name).Activate
Next
票数 0
EN

Stack Overflow用户

发布于 2019-03-28 07:12:16

这应该是可行的:

代码语言:javascript
复制
Sub TFRdataExtract()

    Dim iSheet As Worksheet, rngCopy As Range

    For Each iSheet In ThisWorkbook.WorkSheets

        If iSheet.Name Like "Table*" Then

            With iSheet                                            '<< no need to activate!
                .Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)" '<< no need to select!
                .Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
                .Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
                'etc etc


                Set rngCopy = .Range("AB1:CY1")
            End with

            'assign values directly
            With ThisWorkbook.Sheets("Combined").Range("A2")
                .Resize(rngCopy.Rows.Count, _
                        rngCopy.Columns.Count).Value = rngCopy.Value
            End with

        End If 'EDIT - added

    Next iSheet

End Sub
票数 0
EN

Stack Overflow用户

发布于 2019-03-28 07:22:48

也许这会有所帮助。注释,以帮助理解正在发生的事情。

代码语言:javascript
复制
'// Modify as desired, like to empty rows/columns.
Private Function GetRangeToCopy(zWorksheet As Worksheet) As Range
    Set GetRangeToCopy= zWorksheet.UsedRange
End Function


'// Modify to add spacing or whatnot.
Private Function GetDestinationRange(zDestinationWorksheet As Worksheet, zRowCount As Long, zColumnCount As Long) As Range
    Dim zReturnRange As Range
    Dim zNewRowIndex As Long

    Let zNewRowIndex = zDestinationWorksheet.UsedRange.End.Row + 3 '// Increase to add more rows between inserts.
    Set zReturnRange = zDestinationWorksheet.

    Set GetDestinationRange = zReturnRange
End Function


'// Copies a range to the destination range.
Private Sub CopyRange(zSourceRange As Range, zDestinationRange As Range)
    '// This is where copying styles and such would be done.
    '// We will just call copy for simplicity.

    '// Clear.
    Call zDestinationRange.Clear

    '// Copy.
    Call zSourceRange.Copy(zDestinationRange)
End Sub


'// Copy worksheets to a destination worksheet.
'// Destination worksheet can be a worksheet loaded into a different workbook altogether.
Public Sub CopyWorksheetsTo(zDestinationWorksheet As Worksheet, zClearDestinationWorksheet As Boolean = False _
zPopupCurrentWorksheet As Boolean = True)
    Dim zCurrentWorksheet As Worksheet
    Dim zCurrentWorksheet_Var As Variant
    Dim zRangeToCopy As Range
    Dim zDestinationRange As Range

    '// Clear destination.
    If (zClearDestinationWorksheet) Then
        Call zDestinationWorksheet.UsedRange.Clear
    End If

    '// Cycle through each worksheet in the workbook.
    ForEach zCurrentWorksheet_Var in Worksheets
        '// this allow us the Intellisense while coding.
        Set zCurrentWorksheet = zCurrentWorksheet_Var

        '// Make sure this isn't the destination worksheet.
        If (zCurrentWorksheet.Name <> zDestinationWorksheet.Name) Then
            '// Popup worksheet name.
            If (zPopupCurrentWorksheet) Then
                Call MsgBox(zCurrentWorksheet.Name)
            End If

            '// Get range to be copied.
            Set zRangeToCopy = GetRangeToCopy(zCurrentWorksheet)

            '// Get destination range.
            Set zDestinationRange = GetDestinationRange(zDestinationWorksheet)

            '// Copy range.
            Call CopyRange(zRangeToCopy, zDestinationRange)
        End If
    Next xCurrentWorksheet_Var
End Sub
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/55387365

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档