Macro voor kopieren van opmaak van meerdere cellen.

[Vitjen]

Hallo,

Op het werk maken wij gebruik van een takenplanning via excel.
Elke maand heeft een apart werkblad en daarop staat per naam wat die persoon in voor- en namiddag moet doen.
Ok zijn deze cellen gekleurd. (elke kleur heeft een betekenis; bv rood: late shift, geel: teleworking,...)

Nu heb ik op het laatste werkblad (View) een automatisch overzicht gemaakt van vandaag per taak.
Dit heb ik voor mekaar gekregen via vele codes.
Nu is echter het probleem dat excel uiteraard de opmaak niet mee kopieert.
Wij hadden graag gehad dat per persoon de kleur wel mee kopieert (dit moet dan via macro).

Als je kijkt op het laatste werkblad heb ik wel al voor mekaar gekregen, dat in kolom I (verwijzend naar persoon in kolom F) en kolom J (verwijzend naar persoon in kolom G) telkens de cel vermeld staat van die persoon op het tabblad van de maand te vinden in cel B2. (weet eigenlijk niet of dit nodig is in de macro).

Ik heb wel al gevonden hoe ik van een cel de opmaak kopieer.
Maar ik weet dus niet hoe ik dit voor de volledige kolom I en J kan laten doen + verwijzend naar een cel op een ander tabblad (dat varieert per maand).
Zou iemand me hierbij kunnen helpen aub?

Bekijk bijlage Copy of Unibestand_2013.xlsx


Dank bij voorbaat,
Arvid

 

[Elsendoorn2134]

Vitjen,

Begrijp ik het goed dat je de namen van de personen een opmaak wil geven zoals de cel waarin de dienst vermeld wordt?
Zo ja dan kun je de volgende code gebruiken.

Public Sub KleurNamen()
'
'Kleurt de namen van de medewerkers naar aanleiding van hun shift
'
'-----------------------------------------------------------

Dim nTeller As Integer      'Tel het aantal regels vanaf F6 naar beneden

With Sheets("View").Range("F6")
    For nTeller = 0 To 50                                                   'Tel 50 regels naar beneden vanaf cel F6.
        If .Offset(nTeller, 3) > 0 Then                                     'Eerst de vroege dienst
            Sheets(Mid(Range("L3"), 1, 3)).Range(.Offset(nTeller, 3)).Copy  'Kopieer de gegevens van de maand en de reeks.
            .Offset(nTeller, 0).PasteSpecial Paste:=xlPasteFormats          'Plak speciaal de formats van de zo juist gekopieerde reeks
        End If
        If .Offset(nTeller, 4) > 0 Then                                     'Dan de late dienst
            Sheets(Mid(Range("L3"), 1, 3)).Range(.Offset(nTeller, 4)).Copy  'Kopieer de gegevens van de maand en de reeks.
            .Offset(nTeller, 1).PasteSpecial Paste:=xlPasteFormats          'Plak speciaal de formats van de zo juist gekopieerde reeks
        End If
    Next                                                                    'Volgende regel
End With

End Sub

Ik heb je tabblad View iets aangepast, je had wel een verwijzing gemaakt naar het adres van de betreffende cel in de
ochtend maar nog niet van de middag. Daarom heb ik de kolom N ook naar kolom O gekopieerd, en de kolom I naar J.

Veel Succes.

 

[Vitjen]

Hey Elsendoorn2134,

Bedankt voor de snelle reactie!
Zou je me wel je aangepaste versie eens kunnen doorsturen aub?
Ik heb je jouw macro toegevoegd, maar hij geeft me een fout.
Hij kleurt de ochtend shift wel goed, maar niet de namiddag shift.



Alvast bedankt,
Arvid

 

[zapatr]

vitjen,
je inzet voor wat je gemaakt hebt is bewonderenswaardig, maar het geheel is zo'n kluwen geworden van VEEL te lange formules, vele (al of niet verborgen) hulpkolommen, en beveiligde bladen (waardoor helpers niet echt kunnen helpen), dat een kat haar eigen jongen er niet meer in terug zou vinden. Om slechts twee voorbeelden te geven (maar het aantal kan worden uitgebreid):

1. In het blad "View" kan in N6 deze formule:
=ALS(F6=$L$5;$M$5;ALS(F6=$L$6;$M$6;ALS(F6=$L$7;$M$7;ALS(F6=$L$8;$M$8;ALS(F6=$L$9;$M$9;ALS(F6=$L$10;$M$10;ALS(F6=$L$11;$M$11;ALS(F6=$L$12;$M$12;ALS(F6=$L$13;$M$13;ALS(F6=$L$14;$M$14;ALS(F6=$L$15;$M$15;ALS(F6=$L$16;$M$16;ALS(F6=$L$17;$M$17;ALS(F6=$L$18;$M$18;ALS(F6=$L$19;$M$19;ALS(F6=$L$20;$M$20;ALS(F6=$L$21;$M$21;ALS(F6=$L$22;$M$22;ALS(F6=$L$23;$M$23;ALS(F6=$L$24;$M$24;ALS(F6=$L$25;$M$25;ALS(F6=$L$26;$M$26;ALS(F6=$L$27;$M$27;ALS(F6=$L$28;$M$28;ALS(F6=$L$29;$M$29;ALS(F6=$L$30;$M$30;ALS(F6=$L$31;$M$31;ALS(F6=$L$32;$M$32;ALS(F6=$L$33;$M$33;ALS(F6=$L$34;$M$34;ALS(F6=$L$35;$M$35;ALS(F6=$L$36;$M$36;ALS(F6=$L$37;$M$37;ALS(F6=$L$38;$M$38;ALS(F6=$L$39;$M$39;ALS(F6=$L$40;$M$40;ALS(F6=$L$41;$M$41;ALS(F6=$L$42;$M$42;ALS(F6=$L$43;$M$43;ALS(F6=$L$44;$M$44;ALS(F6=$L$45;$M$45;ALS(F6=$L$46;$M$46;ALS(F6=$L$47;$M$47;ALS(F6=$L$48;$M$48;ALS(F6=$L$49;$M$49;ALS(F6=$L$50;$M$50;ALS(F6=$L$51;$M$51;ALS(F6=$L$52;$M$52;ALS(F6=$L$53;$M$53;ALS(F6=$L$54;$M$54;ALS(F6=$L$55;$M$55;ALS(F6=$L$56;$M$56;""))))))))))))))))))))))))))))))))))))))))))))))))))))

worden vervangen door:

=VERT.ZOEKEN(F6;L$5:M$50;2;0)

2. In het blad "View" kan in F6 deze formule:
=ALS(C5="CB";B5;ALS(C6="CB";B6;ALS(C7="CB";B7;ALS(C8="CB";B8;ALS(C9="CB";B9;ALS(C10="CB";B10;ALS(C11="CB";B11;ALS(C12="CB";B12;ALS(C13="CB";B13;ALS(C14="CB";B14;ALS(C15="CB";B15;ALS(C16="CB";B16;ALS(C17="CB";B17;ALS(C18="CB";B18;ALS(C19="CB";B19;ALS(C20="CB";B20;ALS(C21="CB";B21;ALS(C22="CB";B22;ALS(C23="CB";B23;ALS(C24="CB";B24;ALS(C25="CB";B25;ALS(C26="CB";B26;ALS(C27="CB";B27;ALS(C28="CB";B28;ALS(C29="CB";B29;ALS(C30="CB";B30;ALS(C31="CB";B31;ALS(C32="CB";B32;ALS(C33="CB";B33;ALS(C34="CB";B34;ALS(C35="CB";B35;ALS(C36="CB";B36;ALS(C37="CB";B37;ALS(C38="CB";B38;ALS(C39="CB";B39;ALS(C40="CB";B40;ALS(C41="CB";B41;ALS(C42="CB";B42;ALS(C43="CB";B43;ALS(C44="CB";B44;ALS(C45="CB";B45;ALS(C47="CB";B47;ALS(C48="CB";B48;ALS(C49="CB";B49;ALS(C50="CB";B50;ALS(C51="CB";B51;ALS(C52="CB";B52;"")))))))))))))))))))))))))))))))))))))))))))))))

worden vervangen door deze (via Ctrl-Shift-Enter in te voeren) formule:

=ALS(RIJEN(F$6:F6)<=AANTAL.ALS(C$5:C$50;$F$5);INDEX($B$5:$B$50;KLEINSTE(ALS($C$5:$C$50=$F$5;RIJ($C$5:$C$50)-RIJ($C$5)+1); RIJEN(F$6:F6)));"")

Hoewel de berekeningen ook wel zonder hulpkolommen zouden kunnen, kan een overzicht zoals op het blad "View" het best m.b.v. vba worden gemaakt.