Sub test()
Dim Hoofdtabel As Range 'Hoofdtabel
Dim Begin As Range 'Begin. hier staat "PLOEG 1"
Dim RESERVE As Range 'RESERVE. hier begint Resrve
Dim LaatsteCel As Range 'Laatste cel
Dim Werk As Range 'Werk
Dim OpenDiensten As Range 'open diensten
Dim Afwezig As Integer 'Afwezig
Dim Ofs As Integer
Set Begin = Cells.Find("PLOEG 1")
Set Hoofdtabel = Begin.CurrentRegion
Set LaatsteCel = Hoofdtabel(Hoofdtabel.Rows.Count, Hoofdtabel.Columns.Count)
Set Hoofdtabel = Hoofdtabel.Offset(Begin.Row - Hoofdtabel.Row, Begin.Column - Hoofdtabel.Column).Resize(Hoofdtabel.Rows.Count - Begin.Row + 1, Hoofdtabel.Columns.Count - Begin.Column + 1)
Set RESERVE = Cells.Find("RESERVE")
Set Hoofdtabel = Hoofdtabel.Resize(RESERVE.Row - Hoofdtabel.Row)
Set RESERVE = Range(RESERVE.Offset(1), LaatsteCel)
Set OpenDiensten = Cells.Find("Open diensten")
OpenDiensten.Resize(Hoofdtabel.Rows.Count, Hoofdtabel.Columns.Count).Offset(, 2).Clear
For kolom = 3 To Hoofdtabel.Columns.Count
Ofs = 1
Afwezig = 0
For rij = 1 To Hoofdtabel.Rows.Count + 1
If InStr(1, Hoofdtabel(rij, 1), "PLOEG") > 0 Or Hoofdtabel(rij, 1) = "RESERVE" Then
If Afwezig > 0 Then 'kijken of er reserve genoeg is
For rij2 = 1 To RESERVE.Rows.Count
If RESERVE(rij2, kolom) = Werk And RESERVE(rij2, kolom).Interior.Color = Werk.Interior.Color Then Afwezig = Afwezig - 1
Next
If Afwezig <> 0 Then 'invullen
Werk.Copy OpenDiensten(Ofs, kolom)
If Afwezig <> 1 Then OpenDiensten(Ofs, kolom) = OpenDiensten(Ofs, kolom) & " " & Afwezig
Ofs = Ofs + 1
End If
End If
Set Werk = Hoofdtabel(rij, kolom)
Afwezig = 0
ElseIf Hoofdtabel(rij, kolom) <> "" Then
Afwezig = Afwezig + 1
End If
Next
If Ofs = 1 Then
Hoofdtabel(-2, kolom).Copy OpenDiensten(, kolom)
End If
Next
End Sub
