復制粘貼VBA代碼有空白行

Question

下面的代碼搜索，復制並粘貼找到的數據到另一個工作表中。 但是，在粘貼的工作表中完成此操作后，將出現空白。 例如：在單元格A1中找到“要復制”，並將整個行復制到指定的工作表中。 在A4中找到“待復制”，並將整行復制到指定的工作表中。 但是，A1和A4之間的粘貼工作表中有兩個空白行。 謝謝你的幫助。

Sub Deleting()
    Application.ScreenUpdating = False
    Dim wsh As Worksheet, i As Long, Endr As Long, x1 As Worksheet, p As Long
    Set wsh = ActiveSheet
    Worksheets.Add(Before:=Worksheets("Original Sheet")).Name = "Skipped"
    Set x1 = Worksheets("Skipped")
    Worksheets("ABC").Activate
    i = 2
    Endr = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
    While i <= Endr
        If Cells(i, "A") = "To Be Copied" Then
            wsh.Rows(i).Copy
            x1.Rows(i).PasteSpecial
            p = p + 1
            Endr = Endr + 1
        End If
        i = i + 1
    Wend
End Sub

Answer 1

您需要兩個計數器： i代表源行， j代表目標行。 僅在復制行時遞增j 。

Answer 2

您現有的代碼需要

1. 寫入行位置（切刀點）的單獨計數器，或
2. 使用xlUp粘貼到“跳過”的最后使用的行以查找最后使用的單元格

但是更好的方法是使用AutoFilter一次復制行。 像下面這樣

Sub Quicker()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Application.ScreenUpdating = False
Set ws1 = Sheets("ABC")
Set ws2 = Worksheets.Add(Before:=Worksheets("Original Sheet"))
'in case Skipped exists
On Error Resume Next
ws2.Name = "Skipped"
On Error GoTo 0
ws1.AutoFilterMode = False
Set rng1 = ws1.Range(ws1.[a1], ws1.Cells(Rows.Count, "A").End(xlUp))
rng1.AutoFilter 1, "To Be Copied"
If rng1.SpecialCells(xlCellTypeVisible).Count > 1 Then
    Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1)
    rng1.EntireRow.Copy ws2.[a1]
End If
ws1.AutoFilterMode = False
MsgBox "Sheet " & ws2.Name & " updated"
End Sub