06.02.2009, aktualisiert am 09.02.2009

7793

Arbeitsnachweis aus Vorlage

Hallo,

habe mal wieder ein Problem wo ich erstmal nicht weiter komme.
Ich erstelle gerade einen Arbeitsnachweis mit Excel.

Im Moment ist es so das ich das erste Blatt kopieren muss, neues Tabellenblatt erstellen und dann wieder alles Einfügen. Nach dem einfügen muss ich dann den Monat reinschreiben und die Spalten anpassen usw. Das möchte ich gerne automatisieren. Also ich klick auf einen Button. Dieser erstellt mir dann ein neues Tabellenblatt mit dem nächsten Monat als Namen. In diesem Blatt sollte dann die Anzahl der Tage stimmen z.B. wenn es der Monat Februar 2009 ist dann sollen 28 Tage in der Tabelle stehen.
Samstage und Sonntage sollen ausgegraut werden und die Formeln in den Zeilen gelöscht.

Über bedingte Formatierung kann ich hier leider nicht gehen da ich die schon in der Tabelle verwende und ausgenutzt habe. Hier ist mal mein Anfang. Vll. findet sich ja wer der mir da helfen kann.

http://www.file-upload.net/download-1434327/muster.xls.html

Danke euch

Edit:

Hab am Wochenende mitbekommen das meine Makros garnicht mit in der Datei sind. Deshalb hier nochmal die Makros:
Wie kann ich die mit in der Datei speichern? Also so das die in der Excel Datei immer enthalten sind?

Die hier kommen in Tabelle 1

Sub CommandButton1_Click()
Dim rg As Range
Set rg = Range("A6:A33").Find(What:=Date, After:=Range("A6"), LookIn:= _  
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False)
    If rg Is Nothing Then
        MsgBox "Datum " & Date & " nicht gefunden"  
    Else
        rg.EntireRow.Select
        Selection.Copy
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    End If
End Sub

Private Sub CommandButton2_Click() 'Druckt die Datei mit PDF-Xchange  

datname = "Gleitzeit" & Str(Month(Date)) & Str(Year(Date))  
Range("A1:M40").PrintOut Copies:=1  
Application.SendKeys datname, True 'Gibt den Dateinamen ein  
Application.SendKeys "{ENTER}", True 'Sendet ein Enter zur Namensbestätigung  
Application.SendKeys "{ENTER}", True 'Sendet ein Enter zur Pfadauswahl  
Application.SendKeys "{ENTER}", True 'Sendet ein Enter falls die Datei schon exisitert  

End Sub

Private Sub CommandButton3_Click()
Calculate
Application.OnTime Now + TimeValue("00:00:01"), "timer"  
End Sub

Modul 1

Sub timer()
Calculate
Application.OnTime Now + TimeValue("00:00:01"), "timer"  
End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 108271

Url: https://administrator.de/contentid/108271

Ausgedruckt am: 22.11.2024 um 16:11 Uhr

6 Kommentare

Neuester Kommentar

Kann denn keiner mal was dazu sagen?

Zitat von @L0c4lh0sT:

Kann denn keiner mal was dazu sagen?

Hallo,

Im Moment ist es so das ich das erste Blatt kopieren muss, neues Tabellenblatt erstellen und dann wieder alles Einfügen. Nach dem einfügen muss ich dann den Monat reinschreiben und die Spalten anpassen usw.

Also zumindest das Spaltenanpassen kannst du dir sparen, wenn du das Blatt kopierst in dem du mit der rechten Maustaste auf das Blatt klickst und "Verschieben/Kopieren" auswählst und noch den Haken "Kopie erstellen" aktivierst.

Das möchte ich gerne automatisieren.

Gute Idee. Muss es unbedingt eine Datei pro Monat sein? Wie bereits in einer PN an dich mitgeteilt, habe ich mich am Wochenende mal rangesetzt. Per Code wird eine Datei für das ganze Jahr erstellt.
Ich bin nur ein armer Admin und Freizeit-Coder, was Excel anbelangt. Also bitte beim Anblick des Codes nicht lachen. Konstruktive Kritik ist natürlich willkommen

Dim wb As Workbook
Dim ws As Worksheet

Sub TableData()
    
' Liefert die Eckdaten fuer das neue Blatt  
    
' Vorarbeiten:  
' Im ersten Blatt muss in der Zelle A1 das Datum des ersten Tag des Jahres eingegeben werden  
' In ersten Blatt muss in der Zelle B1 der Gleitzeitwert vom Dezember des Vorjahres eingegeben werden  
    
    Dim currentYear
    Dim prevMonth As Range
    Dim dFirstDayOfMonth As Date
    Dim h, i As Integer
    Dim iTables As Integer
    Dim iDays As Integer
    Dim sTitle As String
    
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    ws.Name = "Setup" ' Aendert Tabellenname  
    ' Bereich "Setup_Vormonat": Gleitzeit-Wert des Vorjahres  
    Set prevMonth = ws.Range("B1")  
    With prevMonth
        .NumberFormat = "0.00"  
        .Name = "Setup_Vormonat"  
    End With
    
    ' Aktuelles Jahr auslesen  
    currentYear = Year(ws.Cells(1, 1))
    
    ' Überzählige Tabellen löschen  
    iTables = wb.Worksheets.Count
    If iTables > 1 Then
    For h = iTables To 2 Step -1
        wb.Worksheets(h).Delete
    Next h
    End If
    
    ' Anhand des Monatsersten (dFirstdayOfMonth) wird der Blatttitel und die Anzahl der Tage des jeweiligen Monats ermittelt.  
    ' Fuer das Februarblatt muss noch ermittelt werden, ob das Jahr ein Schaltjahr ist.  
    For i = 1 To 12
        Select Case i
            Case 1
                dFirstDayOfMonth = ws.Cells(1, 1)
                sTitle = "Januar"  
                iDays = 31
            Case 2
                sTitle = "Februar"  
                If schaltjahr(currentYear) = True Then
                    iDays = 29
                Else
                    iDays = 28
                End If
            Case 3
                sTitle = "März"  
                iDays = 31
            Case 4
                sTitle = "April"  
                iDays = 30
            Case 5
                sTitle = "Mai"  
                iDays = 31
            Case 6
                sTitle = "Juni"  
                iDays = 30
            Case 7
                sTitle = "Juli"  
                iDays = 31
            Case 8
                sTitle = "August"  
                iDays = 31
            Case 9
                sTitle = "September"  
                iDays = 30
            Case 10
                sTitle = "Oktober"  
                iDays = 31
            Case 11
                sTitle = "November"  
                iDays = 30
            Case 12
                sTitle = "Dezember"  
                iDays = 31
        End Select
        
        ' Tabelle erstellen  
        Call CreateTable(sTitle)
        Call TableHeader(sTitle)
        Call createWorkingtime(iDays, dFirstDayOfMonth)
    Next i
           
End Sub

Sub CreateTable(sTitle As String)

' Erstellt ein neues Blatt  
    
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets.Add(, wb.Sheets(wb.Sheets.Count))
    ws.Name = sTitle
End Sub

Sub TableHeader(sMonth As String)
    
' Generiert den Blattkopf und passt Spaltenbreiten und Zeilenhoehen an.  
    
    Dim i As Integer
    Set ws = ActiveSheet
        
    ' Zeilenhoehen festlegen  
    For i = 1 To 3
        ws.Rows(i).RowHeight = 12.75
    Next i
    ws.Rows(4).RowHeight = 13.5
    ws.Rows(5).RowHeight = 39.75
    
    ' Spaltenbreiten festlegen  
    ws.Columns("A").ColumnWidth = 14.71  
    ws.Columns("B").ColumnWidth = 12.86  
    ws.Columns("C").ColumnWidth = 12.43  
    ws.Columns("D").ColumnWidth = 10.57  
    ws.Columns("E").ColumnWidth = 11.71  
    ws.Columns("F").ColumnWidth = 7.14  
    ws.Columns("G").ColumnWidth = 10.71  
    ws.Columns("H").ColumnWidth = 11.29  
    ws.Columns("I").ColumnWidth = 12#  
    ws.Columns("J").ColumnWidth = 10.71  
    ws.Columns("K").ColumnWidth = 6.14  
    ws.Columns("L").ColumnWidth = 10.71  
    
    ' Aktuelles Datum in Zelle A1  
    With ws.Cells(1, 1)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Value = "=Today()"  
    End With
    
    ' Blattueberschrift  
    With ws.Range("A2:C2")  
        .VerticalAlignment = xlBottom
        .BorderAround xlContinuous, xlThin
        .Font.Bold = True
        .Cells(1, 1).Value = "Gleitzeittabelle"  
        .Cells(1, 2).Value = "für den Monat"  
        .Cells(1, 3).Value = sMonth
    End With
    
    ' Uebertrag vom Vormonat  
    With ws.Range("J4")  
        .HorizontalAlignment = xlCenter
        .Formula = "=" & wb.Worksheets((ws.Index) - 1).Name & "!" & wb.Worksheets((ws.Index) - 1).Name & "_Vormonat"  
        .NumberFormat = "0.00"  
    End With
    
    ' Kopfzeile der Zeiterfassung  
    With ws.Range("A5:L5")  
        .VerticalAlignment = xlBottom
        .HorizontalAlignment = xlCenter
        .BorderAround xlContinuous, xlThick
        .Borders(xlInsideVertical).Weight = xlThin
        .Cells.WrapText = True
        .Cells(1, 1).Value = "Datum"  
        .Cells(1, 2).Value = "Wochentag"  
        .Cells(1, 3).Value = "Startzeit"  
        .Cells(1, 4).Value = "Uhrzeit"  
        .Cells(1, 5).Value = "Gearbeitet"  
        .Cells(1, 6).Value = "Soll"  
        .Cells(1, 7).Value = "Feierabend ohne Mehrarbeit"  
        .Cells(1, 8).Value = "Arbeit %"  
        .Cells(1, 9).Value = "Mehrarbeit Stunde"  
        .Cells(1, 10).Value = "Gleitzeit"  
        .Cells(1, 11).Value = "Fertig"  
        .Cells(1, 12).Value = "Urlaub / Schule / Feiertag"  
    End With
End Sub

Sub createWorkingtime(iDays As Integer, dFirstDayOfMonth As Date)
    
' Generiert die eigentliche Arbeitszeiterfassung  
' Legt die benutzerdefinierten Uhrzeitformate fest  
 
    Dim i As Integer
    Dim totRange As Range
    Dim rowRange As Range
    Dim prevMonth As Range
    Dim x, y, z As Integer
    Set ws = ActiveSheet
    
    x = 12  ' Spaltenindex  
    y = 6   ' Zeilenindex  
    z = 6   ' Zähler  
    
    ' Formate festlegen  
    datFormat = "[$-407]DD/ MM;@"   ' Datumformat  
    wtFormat = "DDDD"               ' Wochentagformat  
    startFormat = "h:mm;@"          ' Startzeitformat  
    clockFormat = "hh:mm:ss;@"      ' Uhrzeitformat  
    workedFormat = "hh:mm:ss;@"     ' "Gearbeitet"-Format  
    fomFormat = "h:mm;@"            ' "Feierabend ohne Mehrarbeit"-Format  
    workFormat = "0.00%"            ' "Arbeit in Prozent"-Format  
    otFormat = "0.00"               ' "Mehrarbeit"-Format  
    flextimeFormat = "0.00"         ' Gleitzeit-Format  
    
    ' Arbeitszeitbereich definieren  
    Set totRange = ws.Range(Cells(y, 1), Cells(y + iDays - 1, x))
    With totRange
        .Cells.RowHeight = 13.5
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlEdgeTop).Weight = xlThick
        .Columns(1).HorizontalAlignment = xlRight
        .Columns(1).NumberFormat = datFormat
        .Columns(2).HorizontalAlignment = xlLeft
        .Columns(2).NumberFormat = wtFormat
        .Columns(3).HorizontalAlignment = xlCenter
        .Columns(3).NumberFormat = startFormat
        .Columns(4).HorizontalAlignment = xlCenter
        .Columns(4).NumberFormat = clockFormat
        .Columns(5).HorizontalAlignment = xlRight
        .Columns(5).NumberFormat = workedFormat
        .Columns(6).HorizontalAlignment = xlCenter
        .Columns(7).HorizontalAlignment = xlCenter
        .Columns(7).NumberFormat = fomFormat
        .Columns(8).Font.Bold = True
        .Columns(8).HorizontalAlignment = xlRight
        .Columns(8).NumberFormat = workFormat
        .Columns(8).Interior.Pattern = xlSolid
        .Columns(8).Interior.ColorIndex = 1
        .Columns(8).FormatConditions.Delete
        .Columns(8).FormatConditions.Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=0,25").Font.ColorIndex = 3  
        .Columns(8).FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:="=0,25", Formula2:="=1").Font.ColorIndex = 6  
        .Columns(8).FormatConditions.Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:="=1").Font.ColorIndex = 4  
        .Columns(9).HorizontalAlignment = xlCenter
        .Columns(9).NumberFormat = otFormat
        .Columns(10).HorizontalAlignment = xlCenter
        .Columns(10).NumberFormat = flextimeFormat
        .Columns(11).HorizontalAlignment = xlCenter
        .Columns(12).HorizontalAlignment = xlLeft
    End With
    
    
    For i = 1 To iDays
        Set rowRange = ws.Range(Cells(y - 1 + i, 1), Cells(y - 1 + i, x))
        With rowRange
            ' Datum  
            If freeDays(dFirstDayOfMonth) = True Then
                .Interior.ColorIndex = 15
            ElseIf weekend(dFirstDayOfMonth) = True Then
                .Interior.ColorIndex = 16
            End If
            .Cells(1, 1).Value = dFirstDayOfMonth
            ' Wochentag  
            .Cells(1, 2).Formula = "=A" & z  
            ' Startzeit  
            ' Uhrzeit  
            .Cells(1, 4).Formula = "=IF(K" & z & "=""X"","""",Now())"  
            ' Gearbeitet  
            .Cells(1, 5).Formula = "=IF(L" & z & "<>"""",""07:45"",IF(D" & z & "="""",,D" & z & "-C" & z & "))"  
            ' Soll  
            .Cells(1, 6).Formula = "=""07:45"""  
            ' Feierabend ohne Mehrarbeit  
            .Cells(1, 7).Formula = "=IF(C" & z & "="""",,C" & z & "+D" & z & ")"  
            ' Arbeit %  
            .Cells(1, 8).Formula = "=TEXT(E" & z & ",""hh:mm"")/(TEXT(F" & z & ",""hh:mm"")/100)/100"  
            ' Mehrarbeit Stunde  
            .Cells(1, 9).Formula = "=IF(TEXT(E" & z & ",""hh:mm"")<=TEXT(F" & z & ",""hh:mm""),0,(TEXT(E" & z & "-F" & z & ",""hh:mm""))*24)"  
            ' Gleitzeit  
            If z = 6 Then
                .Cells(1, 10).Formula = "=J" & (z - 2) & "+I" & z  
            Else
                .Cells(1, 10).Formula = "=J" & (z - 1) & "+I" & z  
            End If
            ' Fertig  
            .Cells(1, 11).Formula = "=IF(TEXT(A" & z & ",""TT.MM.JJJ"")=TEXT($A$1,""TT.MM.JJJJ""),"""",""X"")"  
        End With
        dFirstDayOfMonth = DateAdd("d", 1, dFirstDayOfMonth)  
        z = z + 1
    Next i
    
    ' Bereich erstellen fuer Uebertrag in naechsten Monat  
    Set prevMonth = ws.Range("J" & z)  
    With prevMonth
        .Formula = "=J" & z - 1  
        .NumberFormat = "0.00"  
        .HorizontalAlignment = xlCenter
        .Name = ws.Name & "_Vormonat"  
    End With
End Sub

Function schaltjahr(Jahr)
    
' Schaltjahrberechnung  
    
    If (Jahr Mod 4) = 0 And (Jahr Mod 100) <> 0 Or _
     ((Jahr Mod 400) = 0) Then
        schaltjahr = True
    Else
        schaltjahr = False
    End If
End Function

Function weekend(dFirstDayOfMonth) As Boolean

' Berechnet die Wochenenden  

weekend = False
Select Case Weekday(dFirstDayOfMonth)
    Case vbSaturday
        weekend = True
    Case vbSunday
        weekend = True
    End Select
    
End Function

Function freeDays(dFirstDayOfMonth) As Boolean

' Berechnet die Feiertage des Jahres  
' Je nach Bundesland muss bei dem entsprechenden Feiertag der Rückgabewert auf True bzw. False gesetzt werden.  

Dim curYear As Integer
Dim Neujahr, H3K, Karfreitag, Ostermontag, TagderArbeit, ChristiHimmelfahrt, Pfingstmontag, Fronleichnam, MariaeHimmelfahrt, TagderDtEinheit, Reformationstag, Allerheiligen, BussBetTag, Advent4, HeiligAbend, ErsterWeihnachtsfeiertag, ZweiterWeihnachtsfeiertag, Silvester As Date

freeDays = False
curYear = Year(dFirstDayOfMonth)
curDate = Format(dFirstDayOfMonth, "DD.MM.")  

Advent4 = advent(curYear) ' Wird fuer die Berechnung des Buss- und Bettags benoetigt.  

Neujahr = DateSerial(curYear, 1, 1)
H3K = DateSerial(curYear, 1, 6)
Karfreitag = Ostern(curYear) - 2
Ostermontag = Ostern(curYear) + 1
TagderArbeit = DateSerial(curYear, 5, 1)
ChristiHimmelfahrt = Ostern(curYear) + 39
Pfingstmontag = Ostern(curYear) + 50
Fronleichnam = Ostern(curYear) + 60
MariaeHimmelfahrt = DateSerial(curYear, 8, 15)
TagderDtEinheit = DateSerial(curYear, 10, 3)
Reformationstag = DateSerial(curYear, 10, 31)
Allerheiligen = DateSerial(curYear, 11, 1)
BussBetTag = Advent4 - 32
HeiligAbend = DateSerial(curYear, 12, 24)
ErsterWeihnachtsfeiertag = DateSerial(curYear, 12, 25)
ZweiterWeihnachtsfeiertag = DateSerial(curYear, 12, 26)
Silvester = DateSerial(curYear, 12, 31)


Select Case dFirstDayOfMonth
    Case Neujahr
        freeDays = True
    Case H3K
        freeDays = True
    Case Karfreitag
        freeDays = True
    Case Ostermontag
        freeDays = True
    Case TagderArbeit
        freeDays = True
    Case ChristiHimmelfahrt
        freeDays = True
    Case Pfingstmontag
        freeDays = True
    Case Fronleichnam
        freeDays = True
    Case MariaeHimmelfahrt
        freeDays = False
    Case TagderDtEinheit
        freeDays = True
    Case Reformationstag
        freeDays = False
    Case Allerheiligen
        freeDays = True
    Case BussBetTag
        freeDays = False
    Case HeiligAbend
        freeDays = True
    Case ErsterWeihnachtsfeiertag
        freeDays = True
    Case ZweiterWeihnachtsfeiertag
        freeDays = True
    Case Silvester
        freeDays = True
End Select
    
End Function

Function Ostern(Yr As Integer) As Date

' Berechnet den Ostersonntag als Ausgangspunkt für kirchliche Feiertage  

   Dim d As Integer
   d = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
   Ostern = DateSerial(Yr, 3, 1) + d + (d > 48) + 6 - _
    ((Yr + Yr \ 4 + d + (d > 48) + 1) Mod 7)
End Function

Function advent(Yr As Integer) As Date

' Berechnet den 4. Advent des Jahres  

d = DateSerial(Yr, 12, 24)
While Weekday(d) <> vbSunday
    d = d - 1
Wend
advent = d

End Function

Ist alles etwas chaotisch, aber vielleicht findest du die eine oder andere Anregung.

Gruß
petenicker

Das nennst du Friezeit Coder?
Da haste aber untertrieben!
Das ist der Wahnsinn! Hätte ich niemals hingekriegt!

Danke dir vielmals ich werds mal versuchen!

Klappt besser als erwartet. Musste ein bisschen Anpassen weil mein Layout sich geringfügig geändert hatte baer wie gesagt nichts schlimmes. Konntest du ja nicht wissen^^

Hab da nur eine Frage. Wie mach ich das jetzt das meine Buttons auf jedes der Tabellenblätter kommen.
Weil vom Setup Blatt werden die nicht mitkopiert. Wie kann ich das erreichen? Hab ja drei Buttons. "Feierabend machen", "Drucken" und "Aktualisieren".

Ich möchte diese jetzt gerne auf jedem Tabellenblatt einmal vorfinden.

Vll. haste ja noch ne idee. Großartig bis jetzt!

Dankeschön!

MfG
Alex

Zitat von @L0c4lh0sT:

Das nennst du Friezeit Coder?
Da haste aber untertrieben!
Das ist der Wahnsinn! Hätte ich niemals hingekriegt!

Naja, würde sich ein Entwickler den Code anschauen, müsste er wahrscheinlich 2 Wochen unters Sauerstoffzelt.

Danke dir vielmals ich werds mal versuchen!

Gern geschehen.

Hab da nur eine Frage. Wie mach ich das jetzt das meine Buttons auf
jedes der Tabellenblätter kommen.
Weil vom Setup Blatt werden die nicht mitkopiert. Wie kann ich das
erreichen? Hab ja drei Buttons. "Feierabend machen",
"Drucken" und "Aktualisieren".

Gestern bin ich nicht mehr dazu gekommen, vielleicht schaffe ich es heute Abend.

Ich möchte diese jetzt gerne auf jedem Tabellenblatt einmal
vorfinden.

Vll. haste ja noch ne idee. Großartig bis jetzt!

Mir schwebt da was vor. Wie wäre es, wenn sich die drei Buttons anstatt auf jedem Blatt in einem UserForm abgebildet würden? Bei einem Doppelklick auf das Blatt öffnet sich das Formular und du hast deine Buttons zur Verfügung. Wäre das eine Option? Denn ehrlich gesagt finde ich die Vorstellung von insgesamt 36 Buttons nicht sonderlich prickelnd.

Das einzige Problem ist, dass ich noch nicht weiß, wie ich Klassenmodule während der Laufzeit generiere. Zur Not müsste das eben von Hand erfolgen. Aber ich werde mich mal schlau machen.

Gruß
petenicker

Würde auch gehen. Die dürften aber nur auf dem jeweils aktiven Blatt ihre funktion ausüben!

Und noch ne kleine Idee die mir gestern kam: Wäre es möglich den Feiertagsnamen in die Tabelle zu schreiben wenn dieser ist? Und eventuell das SETUP Blatt mit als Informations Blatt nutzen. Also verbleibende Urlaubstage, eine Tabelle wann Urlaub eingetragen ist Geburtstage, Feiertage gleich mit vorne drauf anzeigen?

Achja und wie kann ich ändern das auf dem Setup Blatt die Daten nicht mehr in A1 und B1 stehen sondern z.B. in A2 und B2. Also das mit dem B2 hab ich schon. Nur mit dem A2 komme ich nicht klar. Die einteilung ist da auch sehr komisch von wegen Cells(1,1) hab das auf 2,1 geändert hat auch erst funktioniert aber nur solange wie dann in A1 nichts stand. Wenn ich da was reingeschrieben hatte kam immer ne meldung Falscher Datentyp oder sowas.

Sorry wenn das zuviel ist aber irgendwie blick ich da nicht ganz durch.....

Zitat von @L0c4lh0sT:

Würde auch gehen. Die dürften aber nur auf dem jeweils
aktiven Blatt ihre funktion ausüben!

Da der Doppelklick auf dem aktiven Blatt erfolgt, ist das kein Problem.

Und noch ne kleine Idee die mir gestern kam: Wäre es
möglich den Feiertagsnamen in die Tabelle zu schreiben wenn
dieser ist? Und eventuell das SETUP Blatt mit als Informations Blatt
nutzen. Also verbleibende Urlaubstage, eine Tabelle wann Urlaub
eingetragen ist Geburtstage, Feiertage gleich mit vorne drauf
anzeigen?

Den Namen der Feiertage in die Tabellen zu schreiben, bekomme ich hin. Beim Resturlaub mache ich mir auch wenig Sorgen. Musst mir halt mitteilen, wieviel Urlaubstage du hast.

Wie stellst du dir das mit den Geburtstagen vor? Hast du eine zusätzliche Spalte, in der dann der Name des Geburtstagskindes stehen soll?

Achja und wie kann ich ändern das auf dem Setup Blatt die Daten
nicht mehr in A1 und B1 stehen sondern z.B. in A2 und B2. Also das mit
dem B2 hab ich schon. Nur mit dem A2 komme ich nicht klar. Die
einteilung ist da auch sehr komisch von wegen Cells(1,1) hab das auf
2,1 geändert hat auch erst funktioniert aber nur solange wie dann
in A1 nichts stand. Wenn ich da was reingeschrieben hatte kam immer ne
meldung Falscher Datentyp oder sowas.

Hast du die Änderung sowohl in Zeile 31 als auch in Zeile 46 der Prozedur TableData durchgeführt. Die Meldung mit dem falschen Datentyp kommt daher, dass er falls die Zelle gefüllt ist von einem Datum ausgeht. Schreibst du normalen Text rein, kommt es zu dem Fehler. Das meinte ich übrigens mit Freizeit-Coder. Normalerweise gehört ein ordentlicher Error-Handler dazu