VBA循环通过运行代码的工作表要么不循环，要么循环，但不运行代码

我试图循环遍历所有的工作表，除了一个名为“summary”的工作表外，在A列中查找一个范围，直到find一个值，然后查看另一个工作簿并获取一些数据，粘贴它，然后继续到列的末尾范围。 然后它应该移动到下一个工作表并重复这个过程。 我已经能够成功执行循环内的代码，但只能在活动工作表上执行。 我已经尝试了'for each'语句的各种迭代。 目前的方式似乎遍历工作表，但不运行的代码。

我如何修改它，使其正常工作？

Sub GetFlows() Dim rng As Range Dim row As Range Dim cell As Range Dim dem1 As String Dim WhereCell As Range Dim ws As Excel.Worksheet Dim iIndex As Integer Dim valueRng As Range Dim x As Long Dim y As Long Set rng = Range("A9:A200") For Each ws In ThisWorkbook.Worksheets If ws.Name <> "summary" Then ws.Activate For x = 1 To rng.Rows.Count dem1 = rng.Cells(x).Value If dem1 <> "" Then Set WhereCell = ThisWorkbook.ActiveSheet.Range("A9:A200").Find(dem1, lookat:=xlPart) Windows("GetFilenames v2.xlsm").Activate Worksheets(dem1).Range("A1").CurrentRegion.Copy WhereCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues Else ThisWorkbook.Activate End If Next x End If Next ws End Sub 

Answer 1

你可以避免所有的Activate和Select和限定所有的Range和Cells statemets内使用With ws 。

因此，在循环遍历所有Worksheets后：

For Each ws In ThisWorkbook.Worksheets ， With ws添加并且所有内部对象都使用ws对象进行限定。

代码 ：

 Option Explicit Sub GetFlows() Dim cell As Range Dim dem1 As String Dim WhereCell As Range Dim ws As Worksheet Dim valueRng As Range Dim x As Long Dim y As Long For Each ws In ThisWorkbook.Worksheets With ws If .Name <> "summary" Then For x = 9 To 200 ' run a loop from row 9 to 200 dem1 = .Range("A" & x).Value If dem1 <> "" Then Set WhereCell = .Range("A9:A200").Find(what:=dem1, LookAt:=xlPart) If Not WhereCell Is Nothing Then Workbooks("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1").CurrentRegion.Copy WhereCell.Offset(, 2).PasteSpecial xlPasteValues End If End If Next x End If End With Next ws End Sub 

Answer 2

你能试试吗？ 这将检查是否find该值。

 Sub GetFlows() Dim rng As Range Dim row As Range Dim cell As Range Dim dem1 As String Dim WhereCell As Range Dim ws As Excel.Worksheet Dim iIndex As Integer Dim valueRng As Range Dim x As Long Dim y As Long Set rng = Range("A9:A200") ' should specify a sheet here, presumably Summary? For Each ws In ThisWorkbook.Worksheets If ws.Name <> "summary" Then For x = 1 To rng.Rows.Count dem1 = rng.Cells(x).Value If dem1 <> vbNullString Then Set WhereCell = ws.Range("A9:A200").Find(dem1, lookat:=xlPart) If Not WhereCell Is Nothing Then Workbooks("GetFilenames v2.xlsm").Worksheets(dem1).Range("A1").CurrentRegion.Copy WhereCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues End If End If Next x End If Next ws End Sub