错误的数据被复制到另一张表中

Question

我根据B中的单词PRNA复制来自两列A和B的一些数据，然后将A和B复制到“Sheet1”中。我现在面临的问题是它复制了PRNA的所有内容，但有时也会复制Not available。这是代码：

 Dim Cell2 As Range, LastRow2 As Long
    Dim count As Integer

    LastRow2 = Cells(Rows.count, "B").End(xlUp).Row
    Set rng3 = Range("B2:B" & LastRow2)
     Set ws = Sheets("Sheet1")
    For Each Cell2 In rng3

        If Cell2.Value = "PRNA" Then
            'Range(Cells(rng3.Row, 1), Cells(rng3.Row, 2)).Copy

            'Range("A1").Offset(count, 0).PasteSpecial

            Range(Cells(Cell2.Row, 1), Cells(Cell2.Row, 2)).Copy Destination:=ws.Range("A1").Offset(count, 0)
            count = count + 1

        End If

    Next Cell2

所以我只复制PRNA和单元格A旁边的单元格A PRNA。

这是输出：

我不知道这里的问题是什么..可能它循环太快了吗？

Answer 1

你可以试试这个：你可能正在复制公式，这只会复制值。

    Sub CopyStuff()
Dim rng3 As Range
Dim cell2 As Range
Set rng3 = ActiveSheet.Range("B1:B10")
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
Dim rng As Range
Application.EnableEvents = False
For Each cell2 In rng3
    If UCase(cell2.Value) = UCase("PRNA") Then
        Set rng = cell2.Offset(0, -1)
        ws.Range(rng.Address).Resize(1, 2).Value = Array(rng.Value, cell2.Value)
    End If
Next cell2
Application.EnableEvents = True
End Sub

Answer 2

这将有效：

Sub copyPRNA()
Dim ows As Worksheet
Dim tws As Worksheet
Dim rng As Range
Dim cell2 As Range
Dim cnt As Long

Set ows = ActiveSheet
Set tws = Sheets("Sheet1")

Set rng = ows.Range(ows.Range("B2"), ows.Range("B" & ows.Rows.Count).End(xlUp))

For Each cell2 In rng
    If cell2 = "PRNA" Then
        tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = ows.Range(cell2.Offset(, -1), cell2).Value
    End If
Next cell2

End Sub

使用范围和单元格时，始终要对父级进行限定。