通过Excel工作簿中的所有工作表循环一个macros

我正试图通过Excel工作簿中的所有工作表来运行macros。 我有下面的代码，但它只循环通过第一个工作表。 该macros一次又一次地在第一个工作表中运行，而不是像它应该进入下一个工作表。 有人可以帮忙吗？ 以下是我的VBA代码。

Sub WorksheetLoop() Dim WS_Count As Integer Dim I As Integer ' Set WS_Count equal to the number of worksheets in the active ' workbook. WS_Count = ActiveWorkbook.Worksheets.Count ' Begin the loop. For I = 1 To WS_Count ' Insert your code here. 'lRow = .Range("A" & .Rows.Count).End(xlUp).Row Range("P4").Select ActiveCell.FormulaR1C1 = "=RC[-10]&"" ""&RC[-5]" Range("P4").Select Selection.AutoFill Destination:=Range("P4:P65536"), Type:=xlFillDefault Range("P4:P500").Select ActiveWindow.SmallScroll Down:=-24 Selection.Copy Range("R4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Range("$R4:$R500").RemoveDuplicates Columns:=1, Header:=xlNo Selection.TextToColumns Destination:=Range("R4"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Range("U4").Select ActiveCell.FormulaR1C1 = "=INDEX(C[-16],MATCH(RC[-3],C[-15],0))" Range("V4").Select ActiveCell.FormulaR1C1 = "=INDEX(C[-12],MATCH(RC[-3],C[-11],0))" Range("U4:V4").Select Selection.AutoFill Destination:=Range("U4:V41"), Type:=xlFillDefault Range("U4:V500").Select ' The following line shows how to reference a sheet within ' the loop by displaying the worksheet name in a dialog box. 'MsgBox ActiveWorkbook.Worksheets(I).Name Next I Exit Sub End Sub 

Answer 1

您需要通过每个循环切换到每个工作表。 你基本上只是引用同一个。 你的代码应该是这样的：

 Sub WorksheetLoop() Dim WS_Count As Integer Dim I As Integer ' Set WS_Count equal to the number of worksheets in the active ' workbook. WS_Count = ActiveWorkbook.Worksheets.Count ' Begin the loop. For I = 1 To WS_Count ' Insert your code here. Sheets(I).Select ' Added this command to loop through the sheets 'lRow = .Range("A" & .Rows.Count).End(xlUp).Row Range("P4").Select ActiveCell.FormulaR1C1 = "=RC[-10]&"" ""&RC[-5]" Range("P4").Select Selection.AutoFill Destination:=Range("P4:P65536"), Type:=xlFillDefault Range("P4:P500").Select ActiveWindow.SmallScroll Down:=-24 Selection.Copy Range("R4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Range("$R4:$R500").RemoveDuplicates Columns:=1, Header:=xlNo Selection.TextToColumns Destination:=Range("R4"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Range("U4").Select ActiveCell.FormulaR1C1 = "=INDEX(C[-16],MATCH(RC[-3],C[-15],0))" Range("V4").Select ActiveCell.FormulaR1C1 = "=INDEX(C[-12],MATCH(RC[-3],C[-11],0))" Range("U4:V4").Select Selection.AutoFill Destination:=Range("U4:V41"), Type:=xlFillDefault Range("U4:V500").Select ' The following line shows how to reference a sheet within ' the loop by displaying the worksheet name in a dialog box. 'MsgBox ActiveWorkbook.Worksheets(I).Name Next I Exit Sub End Sub 

没有检查其他代码的有效性，但是我添加的命令将循环显示在表单中。 问候，

Answer 2

您不需要。select或者。 激活一个工作表来处理它上面的命令。 引用它与一个With … End With语句和前言所有Range对象和Range.Cells属性用句点（例如）来inheritance父工作表引用。

 Sub WorksheetLoop() Dim lRow As Long, w As Long With ActiveWorkbook For w = 1 To .Worksheets.Count With .Worksheets(w) 'the last row should be either from column F or K lRow = .Range("K" & .Rows.Count).End(xlUp).Row .Range("P4:P" & lRow).FormulaR1C1 = "=RC[-10]&CHAR(32)&RC[-5]" '.Range("P4:P" & lRow).Formula = "=F4&CHAR(32)&K4" With .Range("R4:R" & lRow) .Value = .Range("P4:P" & lRow).Value 'direct value transfer is the preferred method for this .RemoveDuplicates Columns:=1, Header:=xlNo .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, _ FieldInfo:=Array(Array(1, 1), Array(2, 1)) End With 'R had duplicates removed; get the new last row lRow = .Range("R" & .Rows.Count).End(xlUp).Row .Range("U4:U" & lRow).FormulaR1C1 = "=INDEX(C[-16],MATCH(RC[-3],C[-15],0))" '.Range("U4:U" & lRow).Formula = "=INDEX(E:E, MATCH(R4, F:F, 0))" .Range("V4:V" & lRow).FormulaR1C1 = "=INDEX(C[-12],MATCH(RC[-3],C[-11],0))" '.Range("V4:V" & lRow).Formula = "=INDEX(J:J, MATCH(S4, K:K, 0))" With .Range("U4:V" & lRow) 'you left your code with columns U and V selected 'maybe more processing here like: '.value = .value '<~~ remove formulas to their values End With End With Next w End With End Sub 

logging的macros代码非常冗长。 通过代码工作总是一个好主意，删除无用的代码行，如ActiveWindow.SmallScroll Down:=-24并在可能的地方进行一般改进。

---

¹ _{请参阅如何避免使用在Excel VBAmacros中select更多的方法来摆脱依靠select和激活来实现您的目标。}

Answer 3

不要循环浏览页数，循环浏览页面。

也摆脱所有那些你不需要它们的activewindow.smallscroll行，并删除select。 像这样的东西：

Range("A1").Formula = "Hello"而不是Range("A1").Select Selection.formula = "Hello"注意，你可以删除Select和Selection

以下是如何循环显示表单的示例：

 Sub WS_Stuff() Dim WS As Worksheet For Each WS In Worksheets MsgBox WS.Name Next End Sub