Question

以下代码搜索，复制＆amp;将找到的数据粘贴到另一个工作表中。但是，在粘贴的工作表中完成此操作时会出现空白。例如：在单元格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

您现有的代码需要

书面行位置（Cutter's point）的单独计数器，或
使用xlUp粘贴到上次使用的“Skipped”行以查找上次使用的单元格

但最好还是使用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

复制粘贴VBA代码具有空行

2 个答案: