getallen van blad 1 naar blad 2 in kleur

[mnemonic]

Hoi,
Ik kom hier maar niet uit, gisteren dacht ik het gevonden te hebben wordt mijn opmaak van cellen ook veranderd.

Op blad Maandag in cel bereik J2:Q41 worden rode, blauwe en groene cijfercombinaties ingevoerd.
Deze zouden automatische ook moeten verschijnen op blad "Dinsdag" in cel bereik A2:H41.
Ook de kleur moet meegenomen worden.

Met de code die ik nu heb werkt het wel op mijn computer maar waar wij het op gaan gebruiken doet over elke verandering wel 10 seconden.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("J2:Q41")) Is Nothing Then
 With Application
  .ScreenUpdating = False
    For Each Cl In Range("J2:Q41")
     Sheets("Dinsdag").Range(Cl.Address).Offset(, -9) = Cl.Value
     Sheets("Dinsdag").Range(Cl.Address).Offset(, -9).Font.ColorIndex = Cl.Font.ColorIndex
    Next
    .ScreenUpdating = True
 End With
End If
End Sub

Deze code vergt heel veel van een computer
Zou iemand mij kunnen helpen met een code die minder vraagt van de computer.

Bekijk bijlage test planning V2.xlsm

Jan

 

[Peter B]

Ik snap niet precies de bedoeling, maar ik denk dat het toevoegen van

.EnableEvents = False

aan het begin en

.EnableEvents = True

helpt om e.e.a. flink te versnellen.

 

[VenA]

Ik zou alleen de actieve cel kopiëren.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J2:Q41")) Is Nothing And Target.Count = 1 Then
    Target.Copy Sheets("Dinsdag").Range(Target.Address).Offset(, -9)
End If
End Sub

[Edit] misschien is het beter om pas te kopiëren als je het blad activeert. (voor blad dinsdag)

Private Sub Worksheet_Activate()
    Sheets("Maandag").Range("J2:Q41").Copy [A2]
End Sub

 

[Peter B]

En ook hier kan het dus nog beter ...

 

[mnemonic]

Peter B en Vena bedankt voor het meedenken.

De laatste code van Vena is super alleen tast deze de opmaak aan die op de dinsdag in cel bereik A2:H41.
Ik heb in het onderstaand bestandje een getallen reeks ingevuld voor de duidelijkheid.
Nr 12 staat naast elkaar daardoor licht de cel geel op.

Als je naar dinsdag gaat kijken zie je dat de opmaak veranderd is en licht 12 blauw niet meer op.
Is dit nog aan te passen?

Bekijk bijlage test planning V2.xlsm

Jan

 

[VenA]

Dan moet je even de voorwaardelijke opmaak goed instellen denk ik.

 

[mnemonic]

Ik heb op dinsdag de voorwaardelijke opmaak opnieuw ingesteld op dubbele cijfers.
Als ik dan van maandag naar dinsdag ga neemt hij de voorwaardelijk opmaak van maandag J2:Q41 mee naar dinsdag A2:H41.
Als dat gebeurt klopt mijn controle niet meer

 

[VenA]

Gaat het zo beter?

Private Sub Worksheet_Activate()
For Each cl In Sheets("Maandag").Cells(1).CurrentRegion.Offset(1, 9).Resize(, 8).SpecialCells(2)
    Range(cl.Address).Offset(, -9) = cl.Value
    Range(cl.Address).Offset(, -9).Font.ColorIndex = cl.Font.ColorIndex
Next cl
End Sub

Als het bestand opgebouwd is van maandag t/m zondag dan kan je deze code in ThisWorbook zetten.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Index > 1 And Sh.Index <= 7 Then
    For Each cl In Sheets(Sh.Index - 1).Cells(1).CurrentRegion.Offset(1, 9).Resize(, 8).SpecialCells(2)
        Range(cl.Address).Offset(, -9) = cl.Value
        Range(cl.Address).Offset(, -9).Font.ColorIndex = cl.Font.ColorIndex
    Next cl
End If
End Sub

De sub KleurSet hoort in een module thuis ipv onder elk tabje.

 

[mnemonic]

Vena we zijn er bijna als ik een reeks invoer gaat het perfect alles wordt meegenomen en de voorwaardelijke opmaak blijft staan.
Maar er is nog één puntje, als ik door de bladen klik en een blad is leeg dan geeft hij fout 1004 "er zijn geen cellen gevonden"

 

[VenA]

Met welke code ben je aan de gang gegaan?

SpecialCells(2) zal deze foutmelding opleveren als er geen gegevens gevonden worden die aan deze voorwaarde voldoen. Dit kan je vrij eenvoudig afvangen door On Error te gebruiken.

 

[mnemonic]

Vena ik heb voor de eerste code gekozen.

 

[VenA]

Deze heeft niet mijn voorkeur. De derde zin ook gelezen en daar iets mee gedaan?

 

[mnemonic]

Ja deze net in een module gezet en uitgetest.
Dus in een module is 1 code voor alle bladen of is dit niet goed?
Mag ik vragen waarom de 1e code niet jou voorkeur is.
Misschien omdat dit op elk blad herhaald moet worden en je 2e code 1x in thisWorkbook.
Ik ben maar een leek met vba maar ik wil het wel graag leren dus zit hier constant in een boek te bladeren om het te proberen te snappen.

 

[mnemonic]

als ik code 2 wil gebruiken moet ik deze iets aanpassen.
Mijn bladen lopen van maandag t/m zaterdag
Moet ik dan

If Sh.Index > 1 And Sh.Index <= 7 Then

van de 7 een 6 maken of lees ik dit verkeerd?

 

[VenA]

Je maakt er voor mij wel een beetje onbegrijpelijke toestand van met vragen en/of opmerkingen.

Dus stoei er zelf maar even mee. Je merkt dan zelf wel wanneer iets wel of niet goed gaat. En anders even terug naar hoofdstuk 1 van het boek

 

[mnemonic]

Ga ik doen vena bedankt voor je medewerking.:thumb:

 

[mnemonic]

Vena de code van jou kijkt niet naar veranderingen.
Als ik ergens eerst een cijfer reeks invoer en die later weghaal blijft deze wel op het volgende blad staan.
Wil je mij hier nog een keer mee helpen?
B.v.d.
Jan

 

[VenA]

Dan zal je de specialcells(2) weg moeten halen.

 

[mnemonic]

Vena bedankt, het werkt nu perfect.