錯誤的數據被複制到另一個工作表

Question

我正在複製兩列A和B中的一些數據，如果B中有單詞PRNA，那麼我將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和電池的旁邊小區B具有PRNA。

這是輸出：

我不知道這裏的問題is..maybe它循環太快了？

Answer 1

這將工作：

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 

始終用範圍和細胞工作時，符合資格的父母。

Answer 2

你可以試試這個：你可能正在複製公式，這隻會複製值。

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