Ein Tabellenblatt für jeden Tag des Jahres...

Frage: Ich habe eine Datei mit einem Tabellenblatt. In A1 steht "01.01.2013". Nun soll für jeden Tag des Jahres ein Tabellenblatt erstellt werden. Schaltjahr soll berücksichtigt werden. Der Name des Tabellenblattes und der Inhalt von jeweils A1 ist das Datum des entsprechenden Tages. Wie geht das?

ACHTUNG: Bitte berücksichtigen:
Hinweis - Workaround...

Hier noch eine Beispieldatei: Tabellenblatt - jeder Tag - Jahr...

Option Explicit
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : Main 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 08.10.2012 
' Purpose   : Tabellenblaetter für jeden Tag des Jahres erstellen 
'-------------------------------------------------------------------------- 
Public Sub Main()
    Dim intDays As Integer
    Dim datDate As Date
    Dim lngCal As Long
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        lngCal = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    With ThisWorkbook
        For intDays = 2 To IIf(Day(DateSerial(Year(.Worksheets _
            (.Worksheets.Count).Range("A1").Value), 2 + 1, 0)) = 29, 366, 365)
            datDate = .Worksheets(.Worksheets.Count).Range("A1").Value
            .Worksheets(1).Copy After:=.Worksheets(.Worksheets.Count)
            .Worksheets(.Worksheets.Count).Name = _
                DateSerial(Year(datDate), Month(datDate), Day(datDate) + 1)
            .Worksheets(.Worksheets.Count).Range("A1").Value = _
                .Worksheets(.Worksheets.Count).Name
        Next intDays
    End With
Fin:
    With Application
        .Goto (ThisWorkbook.Worksheets(1).Range("A1")), True
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = lngCal
        .DisplayAlerts = True
    End With
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...