gekleurde getallen van blad 1 naar blad 2

[mnemonic]

Hallo,
Al een paar keer ben ik hier goed geholpen met een probleem en ik hoop dat dit nu ook weer lukt.
In het test bestandje wordt er op de banen bij de deuren klanten neergezet dit kan links op de deur of rechts. (links of rechts max. 3 per rit)
Dit kan in het rood, blauw en groen.
Ook word hier gekeken of er geen dubbele voor komen die niet naast elkaar mogen staan.
Is dit het geval dan wordt de cel geel als waarschuwing.
klant 3 op deur 8 mag niet naast elkaar staan i.v.m. fouten maken.
Maar ook klant 26 op deur 24 en 25 mag niet want dit is ook naast elkaar.
Dit is gedaan met voorwaardelijke opmaak.

Nu zou ik graag willen dat alles wat op blad 1 in getikt wordt automatische ook op blad 2 gekopieerd wordt.
Dus ook de kleur van de getallen Zonder dat het de voorwaardelijke opmaak instellingen van blad 2 veranderd.
Jan

 

[Cobbe]

Hang dit achter blad:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("F9:K40")) Is Nothing Then
 With Application
  .ScreenUpdating = False
    For Each cl In Range("F9:K40")
     Sheets("Blad2").Range(cl.Address) = cl.Value
    Next
  .ScreenUpdating = True
 End With
End If
End Sub

 

[Timshel]

Even voor mijn nieuwsgierigheid,
In welke bedrijfstak kun je klanten 'neerzetten' op de gewenste plek, als waren het playmobil-poppetjes?

 

[mnemonic]

Bedankt Cobbe voor de snelle reactie.
Ga jou oplossing proberen in mijn orrigineel.
Alvast bedankt,
Jan

 

[mnemonic]

Na een druk weekend ga ik weer verder met mijn Excel bestand.
Ik heb de code van Cobbe gebruikt alleen ik heb met het voorbeeld bestandje een foutje gemaakt.
Blad 1 en 2 waren precies hetzelfde en dat is in het origineel niet zo.
er zit verschil in de kolommen.
Dus moet ik de code aanpassen en tot nu toe lukt mij dat nog niet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("F9:K40")) Is Nothing Then
 With Application
  .ScreenUpdating = False
    For Each cl In Range("F9:K40")
     Sheets("Blad2").Range(cl.Address) = cl.Value
    Next
  .ScreenUpdating = True
 End With
End If
End Sub

Ik neem aan dat regel 6 moet veranderen maar dat lukt me nog niet helemaal.
Kan iemand mij hier mee helpen?
Jan

 

[mnemonic]

Bekijk bijlage Test met kleur per 3(2).xlsm
Was het bestandje vergeten

 

[Cobbe]

Met deze aanpassing zal dat wel lukken:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("F9:K40")) Is Nothing Then
 With Application
  .ScreenUpdating = False
    For Each cl In Range("F9:K40")
     Sheets("Blad2").Range(cl.Address)[B][COLOR="#FF0000"].Offset(, -3)[/COLOR][/B] = cl.Value
    Next
  .ScreenUpdating = True
 End With
End If
End Sub

 

[mnemonic]

Cobbe je bent geweldig.
Het werkt super.
Bedankt hiervoor.
Jan

 

[mnemonic]

Cobbe mag ik je nog één keer lastig vallen,
Ik heb nu de formule in mijn origineel maar de kleuren van de cijfers gaan niet mee.
Zou je mij misschien kunnen vertellen wat ik verkeerd heb gedaan?
Jan

Bekijk bijlage deuren planning verzameling week kopie.xlsm

 

[Cobbe]

Kijk eens of de aanpassing voldoet aan uw wens.

 

[mnemonic]

Bedankt Cobbe nu werkt alles goed in mijn origineel heel heel erg bedankt.:thumb: