复制粘贴 VBA 代码有空白行答案

【问题标题】：Copy Paste VBA Code Has Blank Rows复制粘贴 VBA 代码有空白行
【发布时间】：2012-02-13 09:08:31
【问题描述】：

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

【问题讨论】：

正确缩进你的代码会让每个人（包括你自己）更容易阅读和理解你的代码。这次我为你做了。
@Jean-FrançoisCorbett Corbett 谢谢，下次会记住这一点:)

标签： excel excel-2007 vba

【解决方案1】：

您需要两个计数器：i 用于源行，j 用于目标行。您仅在复制行时增加 j。

【讨论】：

+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

【讨论】：