Option Explicit
Dim Zeile As Integer
Dim ZielZeile As Integer
Dim Monat As String
Dim q_datei As String
Sub Daten_holen()
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
prüfe_ob_vorhanden_letzter_monat
End Sub
Function prüfe_ob_vorhanden_letzter_monat() As Boolean
Dim I As Integer
I = 1
Dim boolsch As Boolean
Do While I <= Worksheets.Count
If Worksheets(I).Name = ersterTag_letztesMonat Then
prüfe_ob_vorhanden_letzter_monat = True
End If
I = I + 1
Loop
Dim statement
If prüfe_ob_vorhanden_letzter_monat = False Then
statement = MsgBox("Die Daten vom " & ersterTag_letztesMonat & " wurden noch nicht eingepflegt. " & _
"Sollen die Daten nun eingefügt werden?", vbQuestion + vbYesNoCancel)
Select Case statement
Case vbYes
MsgBox_popup ("Die Daten werden jetzt eingepflegt")
ThisWorkbook.Worksheets.Add after:=Sheets(1)
ActiveSheet.Name = ersterTag_letztesMonat
daten_kopieren_letzter_Monat
Case vbNo
MsgBox_popup ("Die Daten werden nicht eingepflegt")
Case vbCancel
MsgBox_popup ("Das Programm wird abgebrochen")
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End
End Select
Else
MsgBox "Die Daten vom " & ersterTag_letztesMonat & " wurden bereits eingepflegt", vbInformation
End If
prüfe_ob_vorhanden_aktueller_monat
End Function
Function prüfe_ob_vorhanden_aktueller_monat() As Boolean
Dim I As Integer
I = 1
Do While I <= Worksheets.Count
If Worksheets(I).Name = ersterTag_aktuellesMonat Then
prüfe_ob_vorhanden_aktueller_monat = True
End If
I = I + 1
Loop
Dim statement
If prüfe_ob_vorhanden_aktueller_monat = True Then
MsgBox "Die Daten vom " & ersterTag_aktuellesMonat & " wurden bereits eingepflegt", vbInformation
Else
statement = MsgBox("Die Daten vom " & ersterTag_aktuellesMonat & " wurden noch nicht eingepflegt. " & _
"Sollen die Daten nun eingefügt werden?", vbQuestion + vbYesNoCancel)
Select Case statement
Case vbYes
MsgBox_popup ("Die Daten werden jetzt eingepflegt")
ThisWorkbook.Worksheets.Add after:=Sheets(1)
ActiveSheet.Name = ersterTag_aktuellesMonat
daten_kopieren_aktueller_Monat
Case vbNo
MsgBox_popup ("Die Daten werden nicht eingepflegt")
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Case vbCancel
MsgBox_popup ("Das Programm wird abgebrochen")
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End
End Select
End If
End Function
Sub daten_kopieren_letzter_Monat()
Monat = ersterTag_letztesMonat
q_datei = Monat & "_Mitarbeiterübersicht.xlsx"
Mitarbeiterübersicht_letztes_monat_öffnen
Workbooks(q_datei).Worksheets("CO01").Range("A1:L2").Copy
Workbooks("Krankenstand.xlsm").Worksheets(Monat).Range("A1:L2").PasteSpecial Paste:=xlPasteAll
Workbooks("Krankenstand.xlsm").Worksheets(Monat).Range("A1:L2").PasteSpecial Paste:=8
For Zeile = Range("E" & Rows.Count).End(xlUp).Row To 2 Step -1
Workbooks(q_datei).Activate
If Range("E" & Zeile) = 1605 Or Range("E" & Zeile) = 1830 Then
Workbooks(q_datei).Worksheets("CO01").Range("A" & Zeile & ":L" & Zeile).Copy
ZielZeile = Workbooks("Krankenstand.xlsm").Worksheets(Monat).Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks("Krankenstand.xlsm").Worksheets(Monat).Range("A" & ZielZeile).PasteSpecial Paste:=xlAll
End If
Next
Workbooks(q_datei).Close SaveChanges:=False
MsgBox "Die Daten vom " & Monat & " wurden eingefügt!"
End Sub
Sub daten_kopieren_aktueller_Monat()
Monat = ersterTag_aktuellesMonat
q_datei = Monat & "_Mitarbeiterübersicht.xlsx"
Mitarbeiterübersicht_diesen_monat_öffnen
Workbooks(q_datei).Worksheets("CO01").Range("A1:L2").Copy
Workbooks("Krankenstand.xlsm").Worksheets(Monat).Range("A1:L2").PasteSpecial Paste:=xlPasteAll
Workbooks("Krankenstand.xlsm").Worksheets(Monat).Range("A1:L2").PasteSpecial Paste:=8
For Zeile = Range("E" & Rows.Count).End(xlUp).Row To 2 Step -1
Workbooks(q_datei).Activate
If Range("E" & Zeile) = 1605 Or Range("E" & Zeile) = 1830 Then
Workbooks(q_datei).Worksheets("CO01").Range("A" & Zeile & ":L" & Zeile).Copy
ZielZeile = Workbooks("Krankenstand.xlsm").Worksheets(Monat).Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks("Krankenstand.xlsm").Worksheets(Monat).Range("A" & ZielZeile).PasteSpecial Paste:=xlAll
End If
Next
Workbooks(q_datei).Close SaveChanges:=False
MsgBox "Die Daten vom " & Monat & " wurden eingefügt!"
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Function Mitarbeiterübersicht_letztes_monat_öffnen()
Dim datum As Date
Dim Pfad As String
Dim quelldatei As String
datum = ersterTag_letztesMonat
Pfad = "C:\Users\_name_\Mitarbeiterübersicht\Mitarbeiterübersicht\Originale\"
quelldatei = Pfad & datum & "_Mitarbeiterübersicht.xlsx"
Workbooks.Open quelldatei
End Function
Function Mitarbeiterübersicht_diesen_monat_öffnen()
Dim datum As Date
Dim Pfad As String
Dim quelldatei As String
datum = ersterTag_aktuellesMonat
Pfad = "C:\Users\_name_\Desktop\Mitarbeiterübersicht\Mitarbeiterübersicht\Originale\"
quelldatei = Pfad & datum & "_Mitarbeiterübersicht.xlsx"
Workbooks.Open quelldatei
End Function
Function ersterTag_letztesMonat() As String
Dim LastDay As Date
LastDay = DateSerial(Year(Date), Month(Date), 0)
ersterTag_letztesMonat = LastDay - Day(LastDay) + 1
End Function
Function ersterTag_aktuellesMonat() As Date
ersterTag_aktuellesMonat = DateSerial(Year(Date), Month(Date), 1)
End Function
Public Function MsgBox_popup(text As String)
Dim objWSH As Object
Set objWSH = CreateObject("WScript.Shell")
objWSH.popup text, 1
Set objWSH = Nothing
End Function
Sub hinten_anfuegen()
Dim anzahl_sheets As Integer
anzahl_sheets = Sheets.Count
This.Add after:=Sheets(anzahl_sheets)
End Sub