我需要一個Excel VBA代碼複製粘貼一系列單元格

Question

爲了使我的需求變得簡短而又甜美，我需要一個代碼來完成以下條件。

1. 從範圍A2選擇：G5
   
2. 然後檢查是否與當前的日期我命名錶：電子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]鍵，修改後的程序，看它如何處理拋出的錯誤並繼續在退出或處理有三排偏移粘貼。