Beste Dirk-Jan,
Met onderstaande macro kunt u de gewenste overzichten maken. Bovenaan ziet u de uitgangspunten die ik heb genomen, aangezien het goed mogelijk is dat er nog meer taken bij komen of nog meer namen etc. Onderstaande macro heb ik daarom zo dynamisch mogelijk gemaakt. Ik hoop dat u hier iets mee kunt! Veel succes ermee.:thumb:
Sub TaakPerLeerkracht()
Const Tabbladnaam As String = "Taakbeleid 2014-2015"
Const AantalRijen As Integer = 150
Const AantalHeaderRegels As Integer = 21
Const UrenKolom As Integer = 5
Const AantalNamen As Integer = UrenKolom + 14
'Kolom UrenKolom:5 t/m AantalNamen:19 (kolom E t/m S) zijn gevuld, deze apart opslaan:
For J = UrenKolom To AantalNamen
'Kopieren blad, plakken als waarden en verwijderen header
Sheets(Tabbladnaam).Copy after:=Sheets(Sheets.Count)
Cells.Copy
Cells.PasteSpecial xlPasteValues
Range("1:" & AantalHeaderRegels).Delete
'Kopieer kolom "J" (variabel) naar kolom E. Verwijderen overige kolommen: kolom F t/m Z (alleen kolom A t/m E zijn nodig)
Cells(1, J).EntireColumn.Copy Columns(UrenKolom)
Range(Cells(1, UrenKolom + 1), Cells(1, AantalNamen + 12)).EntireColumn.Delete
'Cel A1: Originele tabbladnaam. Tabbladnaam = waarde uit cel E1
Range("A1") = Tabbladnaam
ActiveSheet.Name = Cells(1, UrenKolom).Value
'Verwijderen lege cellen/uren in kolom E
For I = 2 To AantalRijen
If Cells(AantalRijen + 1 - I, UrenKolom).Value = "" Then Cells(AantalRijen + 1 - I, UrenKolom).EntireRow.Delete
Next I
'Verwijderen naam, indien gelijk aan cel E1
For I = 2 To AantalRijen - 1 'cel E1 niet checken!
If Cells(AantalRijen + 1 - I, UrenKolom).Value = Cells(1, UrenKolom).Value Then Cells(AantalRijen + 1 - I, UrenKolom).EntireRow.Delete
Next I
Next J
Sheets(Tabbladnaam).Activate
MsgBox "Gereed!"
End Sub
