我试图循环遍历所有工作表,除了一个名为'summary'的工作表,向下看A列中的一个范围,直到找到一个值,然后查看另一个工作簿并获取一些数据,粘贴它,然后继续直到列A范围结束。然后它应该移动到下一个工作表并重复该过程。我已经能够成功地在循环中执行代码,但只能在活动工作表上执行。我已经尝试了'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
答案 0 :(得分:2)
你能试试吗?这将检查是否找到了值。
[0]
答案 1 :(得分:2)
您可以使用Activate
来避免所有Select
和Range
,并使您的所有Cells
和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