VBA循环遍历运行代码的工作表要么不循环,要么循环但不运行代码

时间:2017-09-19 16:27:51

标签: excel vba excel-vba loops

我试图循环遍历所有工作表,除了一个名为'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

2 个答案:

答案 0 :(得分:2)

你能试试吗?这将检查是否找到了值。

[0]

答案 1 :(得分:2)

您可以使用Activate来避免所有SelectRange,并使您的所有CellsWith 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