如何使我的VBA代碼遍歷工作簿中的所有工作表？

Question

我的工作簿中有5個工作表（表1，表2，表3，表4和合並表）。 主要工作表是我正在嘗試將其他四個工作表合並到一起並將數據放在下一個空白行上的工作表。

數周來，我一直在搜索不同的代碼解決方案，但無濟於事。

當我單步執行宏並使用循環（在while，for和Each中執行do）時，它只能完美地遍歷表1。 但是我無法讓它遍歷工作表2-4。

我想我知道我的問題在哪里，但是在谷歌搜索的數周中，我仍然找不到解決方案。 我認為問題出在讀取“ Sheets（“表1”）。Select”的行上。 因為代碼似乎一直工作到到達那一行。 然后“當然”返回表1。

這是一個更大項目的測試小組。 我必須從完全位於相同位置的500個文檔中提取信息，但是我必須首先使這4個文檔起作用。

``我已經嘗試過了：

Dim iSheet As Object

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

``我嘗試了這個：

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循環以及網絡上其他盡可能多的循環...沒有任何效果...

這是我需要幫助的代碼：

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個工作表並將數據粘貼到合並的文件中的下一個空白行中。

Answer 1

嘗試這個：

For sht = 1 To Sheets.Count
    Debug.Print sht
    'your code here
    Sheets(sht).Activate'or
    Sheets(Sheets(sht).Name).Activate
Next

Answer 2

這應該工作：

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

Answer 3

也許這會有所幫助。 評論有助於了解發生了什么。

'// 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

Answer 4

在所有工作表上循環

例

Option Explicit
Public Sub Example()
'   // Declare your Variables
    Dim Sht As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    '// loop on all sheets
    For Each Sht In Worksheets
        Debug.Print Sht.Name
        'Do something
    Next

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

End Sub

Answer 5

試試這個代碼片段。 我已經在宏中使用它了。

Sub Combine()

' ensure you have placed the "combined" worksheet as the first sheet

'variable declaration
Dim J As Integer

'copying header row from second sheet
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=ThisWorkbook.Sheets("combined").Range("A1")



'copying data from other sheets
For J = 2 To 4
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=ThisWorkbook.Sheets("combined").Range("A65536")_
.End(xlUp) (2)
Next

ThisWorkbook.Worksheets("combined").Columns.AutoFit


End Sub

Answer 6

我認為您應該避免使用.Select 。 嘗試：

Option Explicit

Sub test()

    Dim ws As Worksheet

    With ThisWorkbook

        For Each ws In .Worksheets

            If ws.Name = "Table 1" Then

                With ws

                    .Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)"
                    .Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
                    .Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
                    .Range("AE1").FormulaR1C1 = "=MID(RC[-10],22,100)"
                    .Range("AF1").FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
                    '....... Add more formulas
                    .Range("AB1:CY1").Copy


                End With

                With .Worksheets("Combined").Range("A2")
                    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End With

            End If

        Next ws

    End With

End Sub