Question

我在两个不同的工作表中有两个列表/列，我想循环。 Sheet2（5000行和11列）包含相关信息，list2 / columnN包含我要比较的文本（如果sheet1中存在相同的文本字符串（300行，1列：list1 / columnA）。

当我得到list1（columnA中的值）和list2（columnN中的值）之间的匹配时。我想在sheet2中复制整行（匹配发生的行）并将其粘贴到新工作表（sheet3）。代码的目标是创建包含所有相关信息的Sheet3（即X行和11列）。

当我逐步运行代码时，代码可以正常工作。但是当我运行它时，几行不会被复制到新工作表中。这就像excel跳过粘贴/无法遍历多行。

我将在下面附上我的代码。如果有人能解释为什么它不起作用并为我提供解决方案，我将不胜感激。

Sub ReturnNewSheet()
Dim List1 As Range
Dim List2 As Range
Dim WB1 As Workbook
Dim WS3 As Worksheet
Dim WS2 As Worksheet

Application.ScreenUpdating = False

Worksheets("Sheet1").Activate
Set List1 = Range("A2", Range("A2").End(xlDown))

Worksheets("Sheet2").Activate
Set List2 = Range("N2", Range("N2").End(xlDown))

Set WB1 = Workbooks("Workbook1")

Set WS3 = WB1.Worksheets("Sheet3")
Set WS2 = WB1.Worksheets("sheet2")

CountOfagents = 0
Range("B2").Select

For Each Agent In List2
    For Each Relevantagent In List1
        If Agent = Relevantagent Then
            ActiveCell.EntireRow.Copy
            WS3.Activate
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveCell.PasteSpecial xlPasteAllUsingSourceTheme
            WS2.Activate
            'ActiveCell.EntireRow.Delete
            Exit For

        End If

    Next Relevantagent

ActiveCell.Offset(1, 0).Select
Next Agent

Application.ScreenUpdating = True

End Sub

循环遍历两个列表时，Excel vba pastespecial无法粘贴所有值

0 个答案: