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

为了使我的要求变得简短而甜蜜，我需要一个代码来完成下面的条件。

1. 从范围A2：G5中select
2. 然后检查以当前datei：e 29-02-2016命名的工作表

如果是的话，那么在A1下面复制粘贴范围留下3行，以便在下面粘贴下面的数据。 如果不是，则创build一个新工作表并用当前date命名，然后在A1下复制粘贴范围，留下3行，以便在下面粘贴下一个数据。

我尝试了下面的代码，但是一旦当前的date表被创build，它就会报错。

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]键浏览已修改的过程，观察它如何处理抛出的错误，并继续退出或处理具有三行偏移的粘贴。