首页 文章

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

提问于
浏览 次
1

我试图循环遍历所有工作表，除了一个名为'summary'，查看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
excel vba excel-vba loops

2 回答

  • 2

    你可以通过使用 With ws 来避免所有 Activate 和 Select 并使你的所有 Range 和 Cells 州内的状态合格 .

    所以在你循环完所有的 Worksheets 之后：

    For Each ws In ThisWorkbook.Worksheets ，添加 With ws ，其中的所有对象都使用 ws 对象进行限定 .

    Code ：

    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
    回复于
  • 2

    你能试试吗？这将检查是否找到了值 .

    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
    回复于

相关问题