Werkrooster omzetten naar individueel rooster

[Joost2501]

Goedemorgen,

Ik heb een werkrooster gemaakt (zie bijlage) en nu wil ik graag individuele roosters maken per werknemer. Hiervoor wil ik per rij van het rooster horizontaal zoeken naar een naam. Wanneer deze naam gevonden is in een van de cellen van het bereik, dan wil ik graag dat excel deze cel inclusief opmaak kopieert. Op deze manier hoop ik door het invullen van de naam van wie het rooster is, direct het werkrooster zichtbaar te krijgen.

In het bestand heb ik voor elke dag een gebruiksrooster met daarbij de ingedeelde werknemers geplaatst. In blad 'individueel rooster' wil ik graag dus overal waar de naam in het rooster voorkomt deze naam zichtbaar hebben. Van belang is dat ook de opmaak wordt gekopieerd, aangezien de opmaak correspondeert met de dienst van de betreffende werknemer.

Wie kan mij hierbij helpen?

 

[alphamax]

Welkom op het forum.
Je hebt netjes een voorbeeldbestandje geplaatst, maar dit is zo uitgebreid dat het de helpers weer afschrikt.
Ook zie ik geen logica in het aantal baden en de medewerkers die erop gezet zijn.
En met de kleuren die daarbij horen snap ik het nog minder.

Je hebt de hoofdbaden
wedstrijdbad 1&2
wedstrijdbad 3&4
wedstrijdbad 5&6
wedstrijdbad 7&8
wedstrijdbad diep
wedstrijdbad ondiep

doelgroepenbad
peuterbad
fitness

de eerste medewerker heeft altijd toezicht op de wedstrijdbaden, de tweede op de andere baden? (doelgroepenbad, peuterbad, fitness)

Met een kleiner duidelijker logischer voorbeeldje wordt je waarschijnlijk beter geholpen.

 

[VenA]

Zorg ervoor dat de indeling van elk blad hetzelfde is dus geen samengevoegde kolommen. Je kan dan deze proberen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$K$1" Then
    Dim u As Range
    t = 1
    Range("A4:CU100").Clear
    For Each sh In Sheets(Array("Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrijdag", "Zaterdag A", "Zondag A", "Zaterdag B", "Zondag B"))
        ar = sh.Range("M3:V72")
        For j = 1 To UBound(ar, 2)
            For jj = 1 To UBound(ar)
                If ar(jj, j) = Target Then
                    If u Is Nothing Then Set u = sh.Cells(jj + 2, 1).Resize(, 10) Else Set u = Union(u, sh.Cells(jj + 2, 1).Resize(, 10))
                End If
            Next jj
        Next j
        If Not u Is Nothing Then u.Copy Cells(4, t)
        t = t + 11
        Set u = Nothing
    Next sh
End If
End Sub