Option Explicit
Private Sub Workbook_Open()
DoIt
End Sub
Private Sub DoIt()
Dim c As Range, ToDo As Range
With Sheets("Tabelle1")
Set c = .Rows(1).Find(Date, , xlValues)
If Not c Is Nothing Then
If c.End(xlDown).Row = .Rows.Count Then
Set ToDo = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
ToDo.Copy c.Offset(1)
Call MsgBox("Copied specified column to " & CStr(Date), vbInformation, "current date detected")
Else
Call MsgBox("Column " & CStr(Date) & " already contains data", vbInformation, "no execution")
End If
End If
End With
End Sub