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

Question

我的工作簿中有 5 个工作表(表 1、表 2、表 3、表 4 和合并)。主工作表是我尝试将其他 4 个工作表合并到并将数据放在下一个空白行上的工作表。

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

当我逐步执行宏并使用循环(执行 while、for 和 Each)时，它只是完美地循环遍历表 1。但我无法让它循环浏览工作表 2-4。

我想我知道我的问题在哪里，但在我几周的谷歌搜索中，我仍然找不到解决方案。 我认为问题出在它显示为"工作表("表 1")的行上。选择"。 因为代码似乎一直工作到那一行。然后它"当然"回到表 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

也许这会有所帮助。评论以帮助了解正在发生的事情。

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

遍历所有工作表

例

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 4

试试这个代码片段。我已经在宏中使用它。

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 5

在我看来，你应该尽量避免.选择。尝试：

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

Answer 6

这应该有效：

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