excel - 我需要一个 Excel VBA 代码来复制粘贴一系列单元格

Question

为了满足我的要求，我需要一个代码来满足以下条件。

从范围 A2 中选择:G5

然后检查是否以当前日期命名的工作表 i:e 29-02-2016

如果是，
然后复制粘贴 A1 中的范围，在下面留下 3 行，以便将下一个数据粘贴到该范围之下。
如果不，
创建一个新工作表并用当前日期命名，然后复制粘贴 A1 中的范围，在下面留下 3 行，以便将下一个数据粘贴到该数据下方。

我尝试了下面的代码，但是一旦创建了当前的日期表，它就会给我错误。

Sub Macro1()

    Sheets("Sheet1").Select
    Range("D3:G12").Select
    Selection.Copy
    sheets = "todaysdate".select
    Dim todaysdate As String
    todaysdate = Format(Date, "dd-mm-yyyy")
AddNew:
    Sheets.Add , Worksheets(Worksheets.Count)
    ActiveSheet.Name = todaysdate
    On Error GoTo AddNew
    Sheets(todaysdate).Select
    Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(3, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

Answer 1

试试这些修改。

Sub Macro1()
    Dim todaysdate As String

    With Worksheets("Sheet1")
        .Range("D3:G12").Copy
    End With

    todaysdate = Format(Date, "dd-mm-yyyy")

    On Error GoTo AddNew
    With Worksheets(todaysdate)
        On Error GoTo 0
        With .Cells(Rows.Count, "A").End(xlUp).Offset(3, 0)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
    End With

    Exit Sub
AddNew:
    With Worksheets.Add(after:=Sheets(Sheets.Count))
        .Name = todaysdate
        With .Cells(Rows.Count, "A").End(xlUp)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
    End With
End Sub

使用 [F8] 键逐步完成修改后的过程，以观察它如何处理抛出的错误并继续退出或处理具有三行偏移量的粘贴。