循环没有通过列表VBA迭代



列表似乎只是选择列表中的第一个单元格,有人可以告诉我我在哪里出错吗?

每次我运行此操作时,它将列表中的第一个单元格分配给ATL选项卡中的单元格(然后将运行许多公式),并将我想要的范围和粘贴在"最终"选项卡上。我希望它可以做到这一点,但是它不会向下移动到其他单元格。我有大约40个电池应该迭代,但是它根本无法使用。有什么想法吗?

Dim x As Integer
Dim List As Range
Dim intcount As Integer
Dim DCs As Worksheet
Dim Form As Worksheet
Dim Final As Worksheet
Dim DCdata As String
Dim wsList As String
Dim rnglistrange As Range

With ThisWorkbook
    Set DCs = .Sheets("List1")
    Set Form = .Sheets("ATL")
    Set Final = .Sheets("Final")
End With
DCs.Select
    intcount = DCs.Cells(Rows.Count, "A").End(xlUp).Row '--Get last row of list.
    Set List = DCs.Range("A1:A" & intcount) '--Qualify our list.
For Each rnglistrange In List '--For every name in list...
        Form.Select
        Range("A2") = List.Value
        Range("A632:N646").Copy
    Final.Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Selection.End(xlToLeft).Select
    Selection.Offset(2, 0).Select
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next

问题在:

Range("A2") = List.Value

只会将List range的第一值放在单元格" A2"

当您想放置时:

Range("A2") = rnglistrange

将在单元格A2

中放置 Current List单元格Value

但您可能还需要考虑对您的代码进行的重构,这是避免Select/Selection/Activate/ActiveXXX模式的主要目标,而有利于完全合格的范围参考,即对您实际上所引用的内容而不是松散的控制并提高性能(和屏幕闪烁)

Option Explicit
Sub main()
    Dim listRng As Range, listCell As Range
    Dim DCs As Worksheet, Form As Worksheet, Final As Worksheet
    With ThisWorkbook 
        Set DCs = .Worksheets("List1")
        Set Form = .Worksheets("ATL")
        Set Final = .Worksheets("Final")
    End With
    With DCs
        Set listRng = .Range("A1", .Cells(Rows.count, "A").End(xlUp)) '--Qualify our list.
    End With
    For Each listCell In listRng '--For every name in list...
        With Form
            .Range("A2") = listCell
            .Range("A632:N646").Copy
        End With
        With Final
            With .Cells(Rows.count, "A").End(xlUp).Offset(2)
                .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            End With
        End With
    Next
End Sub

列表的第25行说:

Range("A2") = List.Value

将该行更改为:

Range("A2") = rnglistrange.Value

您会看到它通过"列表"范围的单元格进行。

最新更新