複製粘貼VBA代碼有空白行

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

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

來源

2012-02-13 User124726

正確縮進你的代碼會讓每個人（包括你自己）都更容易閱讀和理解你的代碼。我這次爲你做了。 – 2012-02-13 10:28:15

@ Jean-FrançoisCorbettCorbett謝謝，下次還會記住這一點:) – User124726 2012-02-13 11:18:49

您現有的代碼需要或者

而立行位置（刀具的點），一個獨立的計數器，或
粘貼使用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

來源

2012-02-13 10:33:44 brettdj

您需要兩個計數器：i爲源行，j爲目標行。複製行時只增加j。

來源

2012-02-13 09:52:30 Cutter

+1否則你的目的地總是與你的來源完全相關 – 2012-02-13 10:29:20

真棒..謝謝@Cutter – User124726 2012-02-13 11:17:01

複製粘貼VBA代碼有空白行

回答

相關問題