voorwaardelijke opmaak mogelijk op gekopieerde cellen?

[bta]

Ik heb twee gedeeltes, met een verschillende naam meegegeven, zeg vak1 en vak2, op blad1. Vanuit blad1 is het mogelijk om gegevens te kopiëren naar blad2. Dat lukt op zich wel. Echter, Ik wil dat de gegevens uit vak2, als ze naar blad2 worden gekopieerd een andere opmaak krijgen, zeg rood lettertype, en de gegevens uit vak1 de gewone opmaak. Is dit mogelijk?
Gr. BTA

 

[richard1970]

Beste bta,

Je vraag is niet helemaal helder.
Kopieer je gegevens handmatig of via een macro?
Je kunt kiezen voor: Bewerken > Plakken Speciaal > Waarden. Dit houdt in dat de geplakte waarden de opmaak van de cel meekrijgen.

Heb je hier wat aan?

Groeten,
Richard

 

[bta]

Richard,
De gegevens worden via een macro gekopieerd naar een (verzamel)blad.
Het betreft op blad1 een keuzelijst met 100 artikelen. 50 in vak1 met zwart letterltype en 50 in vak2 met rood lettertype. Er kan dus uit beide vakken worden gekozen. De gekozen artikelen worden gekopieerd naar een verzamelblad, blad2 en nu wil ik dat de artikelen uit vak1 de oorspronkelijke opmaak, dus zwart lettertype "meenemen" en de artikelen uit vak2 het rode lettertype "meenemen".
Ik ben slecht in uitleggen, maar ik hoop dat je het nu een beetje begrijpt.
Gr. BTA

 

[richard1970]

Als je alles plakt, neem je ook de opmaak mee. Kun je de macrocode hier plaatsen?
Ik ben geen held in VBA, maar dan kunnen anderen ook meekijken.

Richard

 

[bta]

Richard,
Dank je wel voor het meedenken.
De "gewone" artikelen worden uit het blad "artikelen" gekozen (= een standaard-pakket met standaard opmaak, zeg zwart lettertype). Daarnaast kunnen ze onderaan een vrije keuze doen, met een andere opmaak, zeg rood letterype. Die twee soorten moeten een verschillende opmaak hebben, omdat de vrije keuze later goedgekeurd moet worden en ik dus het verschil moet zien. Uiteindelijk worden de gekozen aantallen (standaard en vrije keuze) onder elkaar geplaatst op het blad "bestellijst" en daar zit 'm de truc, maar hoe.
Gr. BTA

Sub maken()
Sheets("artikelen").Unprotect ("bta")
Sheets("bestellijst").Unprotect ("bta")
    Dim Title$, Msg$, Style, Response
    Title = "Bestellijst maken"
    Msg = "Heb je alle door jou gewenste artikelen ingevuld?" _
    & vbCrLf & vbCrLf & "Weet je echt zeker dat de bestellijst kan worden aangemaakt??"
    Style = vbYesNo + vbDefaultButton2
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then Exit Sub
    Dim rij As Long, n%
    n = 10: rij = 3
    With Sheets("bestellijst")
        For rij = 3 To [A169].End(xlUp).Row
            If Cells(rij, 1).Value <> 0 Then
                .Cells(n, 1).Value = Cells(rij, 1).Value
                .Cells(n, 2).Value = Cells(rij, 2).Value
                .Cells(n, 3).Value = Cells(rij, 3).Value
                .Cells(n, 4).Value = Cells(rij, 4).Value
                .Cells(n, 5).Value = Cells(rij, 5).Value
                n = n + 1
            End If
        Next rij
    End With
    Sheets("bestellijst").Select
    Application.GoTo [A1], True: [A2].Select
    Sheets("artikelen").Protect ("bta")
    Sheets("bestellijst").Protect ("bta")
End Sub

 

[Roncancio]

Sub maken()
Sheets("artikelen").Unprotect ("bta")
Sheets("bestellijst").Unprotect ("bta")
    Dim Title$, Msg$, Style, Response
    Title = "Bestellijst maken"
    Msg = "Heb je alle door jou gewenste artikelen ingevuld?" _
    & vbCrLf & vbCrLf & "Weet je echt zeker dat de bestellijst kan worden aangemaakt??"
    Style = vbYesNo + vbDefaultButton2
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then Exit Sub
    Dim rij As Long, n%
    n = 10: rij = 3
    With Sheets("bestellijst")
        For rij = 3 To [A169].End(xlUp).Row
            If Cells(rij, 1).Value <> 0 Then
                .Cells(n, 1).Value = Cells(rij, 1).Value
                .Cells(n, 2).Value = Cells(rij, 2).Value
                .Cells(n, 3).Value = Cells(rij, 3).Value
                .Cells(n, 4).Value = Cells(rij, 4).Value
                .Cells(n, 5).Value = Cells(rij, 5).Value
[COLOR="Red"][B]                If rij>=159 Then .Range("A" & n &":E" & n).Font.Color = vbRed[/B][/COLOR]
                n = n + 1
            End If
        Next rij
    End With
    Sheets("bestellijst").Select
    Application.GoTo [A1], True: [A2].Select
    Sheets("artikelen").Protect ("bta")
    Sheets("bestellijst").Protect ("bta")
End Sub

Alleen de rode regel is toegevoegd aan de code.

Met vriendelijke groet,


Roncancio

 

[bta]

Heel veel dank! Gr. BTA