創建行，然後將原始行復制並粘貼到新行

Question

我有一行指定要在其下插入的行數的單元格。我的代碼的那部分工作正常。然後我想獲取原始行的內容並粘貼到新創建的行中，然後刪除這些行中特定單元格的信息。那是我遇到問題的地方。這裏是我的代碼：

Set ws = ActiveSheet 

Dim rw, num As Long 

rw = 5 

While ws.Cells(rw, 16).Value <> "" 
    num = ws.Cells(rw, 16).Value 

    If num = 0 Then 
     rw = rw + 1 
    Else 

     Range(Cells(rw + 1, 16), Cells(rw + num, 16)).EntireRow.Insert shift:=xlDown 
     Rows(rw).Select 
     Selection.Copy 
     Range(Rows(rw + 1), Rows(rw + num)).Paste 
     Range(Cells(rw + 1, 9), Cells(rw + num, 9)).ClearContents 
     rw = rw + num + 1 
    End If 
Wend 

End Sub 

我不明白爲什麼我不能在原始行內容粘貼到我的新創建的行的原始行被複制，在我的MS剪貼板，但不糊。我已經嘗試使用Range（）。Paste，Rows（）。Paste，Cells（）。粘貼和三個組合，迄今沒有任何工作。任何幫助非常感謝，謝謝。

Answer 1

您可以嘗試

 

    Range(Rows(rw + 1), Rows(rw + num)).PasteSpecial xlPasteValues 
    Application.CutCopyMode = False 

或

 

    Range(Rows(rw + 1), Rows(rw + num)).PasteSpecial Paste:=xlPasteAll, _ 
      Operation:=xlNone, SkipBlanks:=True, Transpose:=False 
     Application.CutCopyMode = False 

Answer 2

我會用什麼@pascalbaro寫也擺脫了SELECT語句。另外，如果這是您唯一的子程序，您可能想要限制屏幕更新。如果不是將它們添加到調用它們的那個中。

Application.ScreenUpdating = False 
Set ws = ActiveSheet 
Dim rw, num As Long 
rw = 5 

While ws.Cells(rw, 16).Value <> "" 
    num = ws.Cells(rw, 16).Value 

    If num = 0 Then 
     rw = rw + 1 
    Else 

     Range(Cells(rw + 1, 16), Cells(rw + num, 16)).EntireRow.Insert shift:=xlDown 

     'remove the selection statements 
     Rows(rw).Copy 

     Range(Rows(rw + 1), Rows(rw + num)).PasteSpecial Paste:=xlPasteAll, _ 
      Operation:=xlNone, SkipBlanks:=True, Transpose:=False 

     Range(Cells(rw + 1, 9), Cells(rw + num, 9)).ClearContents 

     rw = rw + num + 1 

    Application.CutCopyMode = False 

    End If 
Wend 

Application.ScreenUpdating = True