Question

我已经对这个问题持续了2天了。我试图让这段代码从表1复制一个有限的范围，并从特定的单元格开始粘贴到表2中。然后让它返回并将工作表1中的另一个值粘贴到空白处，但停在复制值中的最后一个空白点，但不要低于它。发生的事情是第一部分正在按预期工作，但第二部分是填充整个页面或填充粘贴信息下面的每个单元格以及我想要放入空白单元格中的内容。如果你可以让第一部分范围变得动态，也可以获得奖励积分，但我相信我能自己解决这个问题。

Sub Export()
    Sheets("Sheet1").Select
    Range("A2:A50").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("C3").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("L2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Range("C3:C50").End(xlDown).SpecialCells(xlCellTypeBlanks).Select
    ActiveSheet.Paste
End Sub

我非常喜欢这个，所以我确信这只是我还不知道的事情。任何帮助将不胜感激。

Answer 1

这是未经测试但我认为它会起作用：

Sub Export()
    Dim cell as Range
    Dim x as integer
    Dim s as string
    s = Sheets("Sheet1").Range("L2").Value
    x = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Sheet1").Range("A2:A" & x).Copy
    Sheets("Sheet2").Range("C3").PasteSpecial xlPasteValues
    For Each cell In Sheets("Sheet2").Range("C3:C" & x)
        If cell.value = "" Then
            cell.Value = s
        End If
    Next
    CutCopyMode = False
End Sub

Answer 2

删除所有选择语句后（宏录制器执行此操作，但实际上没有必要）我们可以更清楚地查看您的代码......

Sub Export()
    Sheets("Sheet1").Range("A2:A50").Copy
    Sheets("Sheet2").Range("C3").Paste

    Sheets("Sheet1").Range("L2").Copy
    Application.CutCopyMode = False

    Sheets("Sheet2").Range("C3:C50").End(xlDown).SpecialCells(xlCellTypeBlanks).Paste
End Sub

但我认为你可以为你想做的最简单的代码是

Sub Export()
    Sheets("Sheet2").Range("C3:C52") = Sheets("Sheet1").Range("A1:A50").Value
    On Error Resume Next ' Required because an error is thrown when there are no blanks.
    Sheets("Sheet2").Range("C3:C52").SpecialCells(xlCellTypeBlanks).Value = Sheets("Sheet1").Range("L2")
    On Error GoTo 0
End Sub

Answer 3

只是为了好玩，这是简短的版本：]

Sub Export()
    [Sheet2!C3:C52] = [Sheet1!A1:A50].Value
    Range([Sheet2!C3], [Sheet2!C53].End(xlUp)).Replace "", [Sheet1!L2]
End Sub

阻止宏粘贴整个工作表

3 个答案: