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

创建行，然后将原始行复制并粘贴到新行

2 个答案: