Voorwaardelijke opmaak per bereik in rij kopiëren

[Georgyboy]

Kunnen we deze werkende code aanpassen?

Van 6 To 144 naar laatste regel in dit bereik (hier 144) dus 6 to .......

Sub OpmaakKopiëren()

    ' Kopieer voorwaardelijke opmaak van F5:AA5
    Range("F5:AA5").Copy

    ' Plak de opmaak naar de onderstaande rijen (F6:AA6 tot F144:AA144)
    For rij = 6 To 144
        Range("F" & rij & ":AA" & rij).PasteSpecial Paste:=xlPasteFormats
    Next rij

    ' Wis het klembord
    Application.CutCopyMode = False

    ' Zet de invoermodus uit
    Application.DataEntryMode = False

End Sub

 

[Georgyboy]

Met aangepaste Aantallen.als
en voorwaardelijke opmaak per regel

 

[Georgyboy]

Goeiedag,

Kan onderstaande aangepast worden naar de laatste cel in het bereik, zijnde hier "AA144"?
of moet men steeds de laatste cel in het bereik vermelden " F6:AA6 tot F144:AA144)"?
for rij =6 to ........

Sub OpmaakKopiëren()

' Kopieer voorwaardelijke opmaak van F5:AA5
Range("F5:AA5").Copy

' Plak de opmaak naar de onderstaande rijen (F6:AA6 tot F144:AA144)
For rij = 6 To 144
Range("F" & rij & ":AA" & rij).PasteSpecial Paste:=xlPasteFormats
Next rij

' Wis het klembord
Application.CutCopyMode = False

' Zet de invoermodus uit
Application.DataEntryMode = False

End Sub

Deze geprobeerd maar doet dit van Rij A Tot ........
Maar hier id de opmaak gekopieerd op niet gewenste cellen (bereik)

Sub opmaak()
Rows(5).Copy
For rij = 6 To Cells(Rows.Count, 1).End(xlUp).Row
Rows(rij).PasteSpecial Paste:=xlPasteFormats
Next rij
Application.CutCopyMode = False
End Sub

Alvast bedankt!

 

[snb]

Range("F5").Copy
Range("F6:AA144").PasteSpecial -4122

 

[Georgyboy]

Dankjewel!
Hier zie ik dat de voorwaardelijke opmaak over het gehele bereik gaat en niet regel per regel.
Opmaak van rij 5 (F5:AA5)
Kopiëren naar onderstaande regels (F6:F144) met opmaak regel per regel.

Kan dit ook met F6: & (einde bereik)?

De bedoeling is om in kaart te brengen hoeveel keer we iets moeten maken (Productie Orders) en zo te zien of we deze beter kunnen groeperen. Rood is het grootste aantal van de gewichten tussen 2 waarden (bovenste 2 rijen).

Suggesties om dit beter aan te pakken altijd welkom.

Alvast bedankt!

 

[cow18]

Sub Georgyboy()
     t = Timer
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual

     With Sheets("Test").Range("F5:AA5")     '1e rij met VO
          .Offset(1).Resize(Rows.Count - .Row).FormatConditions.Delete     'alle VO uit de onderliggende rijen verwijderen
          t1 = Timer
          For Each c In .Cells(1).EntireColumn.SpecialCells(xlFormulas)     'alle cellen in kolom F met een formule
               If c.Row > .Row Then
                    cnt = cnt + 1
                    .Copy
                    c.Resize(1, .Columns.Count).PasteSpecial xlFormats
               End If
          Next

     End With
   
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
     Application.CutCopyMode = False
     Application.DataEntryMode = False

     MsgBox Format(Timer - t, "0.00") & " sec voor " & vbLf & cnt & " rijen"

End Sub

Alleen begrijp ik het "groeperen" niet

 

[Georgyboy]

Dankjewel Cow18!
Wauw "bere goed zeg" helemaal Top in 1.07 sec het gewenste resultaat!

 

[cow18]

bedankt.
En nog een kleine aanvulling, de top-3
(het had eigenlijk ook met een draaitabel gekund)