Calender invullen

[schuurar]

Ik heb nu een verzamel staat van de vrij/vakantie dagen die automatisch word gemaakt !
(bedankt Warme Bakkertje)

Nu zou ik dat graag weer willen laten invullen op een calender.
Nu heb ik zitten zoeken en op de site van rdg1314 een vakantie calender gevonden.
Die doet wat ik graag zou willen maar daar zit zo'n ingewikkelde formule in die ik echt niet snap.

Wie zou me kunnen helpen ?

 

[Roncancio]

In het oorspronkelijke bestand werden de kolommen A, B en C ingevuld adhv de gegevens van de werkbladen.
Ik heb de code aangepast zodat het overzicht wordt ingevuld zonder dat de tussenstap van de kolommen A, B en C noodzakelijk zijn.

Met vriendelijke groet,


Roncancio

 

[schuurar]

Sorry voor de late reactie!
Me computer was gecrashed

Ik ga er mee aan de slag kijken of ik het werkend in mijn db krijg!
Bedankt alvast!

 

[schuurar]

Beste Ron,

Ik krijg hem niet helemaal aan de praat in de eigen db.
Zoals jij hem gemaakt had werkt het bijna goed alleen heb ik in mijn db natuurlijk meerdere maanden (zie nieuw bestand)
Ik zou het graag per maand willen invullen. Nu gooid hij het van elke maand bij elkaar.

Eigenlijk zit ik beetje vast nu.
Kun je me een beetje op weg helpen weer ?

Bedankt alvast

 

[Roncancio]

Sub Kalender()
Dim lRij As Long
    Worksheets("Verzamel").Range("maanden").ClearContents
    For I = 1 To Sheets.Count - 1
        Worksheets("Verzamel").Range("F" & lRij).Value = Worksheets(I).Name
        For Each cl In Sheets(I).[D24:X200]
            If cl = "Vakantie" Or cl = "Snipperdag" Or cl = "Ziek" Then
                Set md = Worksheets("Verzamel").Range("A:IV").Find(WorksheetFunction.Proper(Format(cl.Offset(-1, 0), "mmmm")), , xlValues, xlWhole)
                Set DG = Worksheets("Verzamel").Range("A" & md.Row & ":IV" & md.Row + 2).Find(Day(cl.Offset(-1, 0)), , xlValues, xlWhole)
                If md.Offset(1, 0).Value = "" Then lRij = md.Offset(1, 0).Row Else lRij = md.End(xlDown).Range + 1
                Cells(lRij, DG.Column).Value = Left(cl, 1)
            End If
        Next
    Next
End Sub

Met vriendelijke groet,


Roncancio