Excel VBA - 复制数组中的单元格并粘贴到下一个空单元格

Question

VBA 新手并尝试编写一个宏，如果 Y 列包含特定文本 (CHK)，该宏将复制条目的参考编号（A 列）。我已经能够设置一个数组，该数组将检查一个单元格是否包含值 CHK，如果包含则复制参考号（然后对每个单元格重复此操作）。

我正在努力将每个单元格的值粘贴到另一个工作簿的 A 行中的下一个空单元格中。我已设法将值复制到下一个空单元格中，但我不确定如何向下移动一个单元格以进行数组的下一次遍历。而此时，每次数组运行时，单元格中的值都会被覆盖

我当前的代码如下所示：

Sub Copy_detailed_WithNum_V2()

Application.ScreenUpdating = True

Dim ws1 As Worksheet, ws2 As Worksheet
Dim SrchRng As Range, cel As Range

Set ws1 = Sheets("Detailed Register-All")
Set ws2 = Sheets("VIPP Register")
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Activate Detailed Reigster sheet
ws1.Activate

Set SrchRng = Range("Y:Y")


For Each cel In SrchRng

    'Check if the cell contains CHK text
    If InStr(1, cel.Text, "CHK") Then
    'Copy rerference number if entry has CHK value
    cel.Offset(0, -24).Copy
    'Activate VIPP Register sheet
    ws2.Activate
    'Paste in the next empty cell in Coulmn A
    Cells(lastRow + 1, 1).PasteSpecial xlPasteValues

    End If

'Check next cell
Next cel

End Sub

Answer 1

此问题可能是由于您的 Range 和 Cells 实例未通过工作表进行限定。另外，请注意您不需要Activate 工作表即可对其进行修改。

您可以将 2 个范围的值设置为彼此相等，而不是复制值，这就是我在这里所做的。

Laslty，您的搜索范围当前设置为Y:Y，这是整个列（要检查的单元格略多于 100 万个）。您需要将其最小化到最小/必要范围。我有这个设置从Y2开始（假设你有一个标题）并向下扫描到Y列中最后使用的单元格

---

Sub Copy_detailed_WithNum_V2()

Dim ws1 As Worksheet: Set ws1 = Sheets("Detailed Register-All")
Dim ws2 As Worksheet: Set ws2 = Sheets("VIPP Register")
Dim SrchRng As Range, cel As Range, lastRow As Long

Set SrchRng = ws1.Range("Y2:Y" & ws1.Range("Y" & ws1.Rows.Count).End(xlUp).Row)

Application.ScreenUpdating = False
    For Each cel In SrchRng
        If InStr(1, cel.Text, "CHK") Then
            lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1).Row
            ws2.Cells(lastRow, 1).Value = cel.Offset(0, -24).Value
        End If
    Next cel
Application.ScreenUpdating = True

End Sub