exell probleempje

[ginogcsbelgie]

hallo iedereen,
ik heb een code om bepaalde cellen te kleuren na ingave van een getal in een bepaalde cel
wanneer ik bv 1000 ingeef in de cel op die rij in kolom 10 dan kleurt a tot e rood van die rij.
maar ik zou ook nog de inhoud van een bepaalde cel willen kopieren en de waarde plakken in kolom f van die rij na de ingave van het getal 1000 in kolom 10
kan iemand me hiermee helpen?
alvast bedankt

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$z$1" Then Exit Sub
Dim Rij, Waarde As Integer
Rij = Target.Row
If Target.Column = 10 Then

Waarde = Target.Value
If Waarde = 0 Then Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = xlNone: Exit Sub
Select Case Waarde
Case 1000
Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = vbRed

Case 2000
Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = vbGreen

Case 3000
Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = vbYellow
End Select

End If
End Sub

 

[Cobbe]

Zo dan?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$z$1" Then Exit Sub
    Dim Rij, Waarde As Integer

    If Target.Column = 10 Then
        Rij = Target.Row
        If Target.Value = 0 Then Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = xlNone: Exit Sub
        Select Case Target.Value
        Case 1000
            Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = vbRed
            Range("F" & Rij) = range(cel met de te copieren waarde)
        Case 2000
            Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = vbGreen
            Range("F" & Rij) = range(cel met de te copieren waarde)
        Case 3000
            Range(Cells(Rij, "a"), Cells(Rij, "e")).Interior.Color = vbYellow
            Range("F" & Rij) = range(cel met de te copieren waarde)
        End Select

    End If
End Sub

 

[ginogcsbelgie]

bedankt werkt perfect , nog 1 vraagje?
en als ik de cel die moet gekopieerd moet worden op een ander werkblad staat bv werkblad gino genoemd
alvast bedankt

 

[Cobbe]

Dan wordt:

range(cel met de te copieren waarde)

sheets("gino").Range(cel....)

 

[edmoor]

Dat kan je nog wel een stukje efficiënter schrijven:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$Z$1" Then Exit Sub
    Dim Rij As Long, Waarde As Integer, Kleur As Long

    If Target.Column = 10 Then
        Rij = Target.Row
        If Target.Value = 0 Then Range(Cells(Rij, "A"), Cells(Rij, "A")).Interior.Color = xlNone: Exit Sub
        Select Case Target.Value
            Case 1000:  Kleur = vbRed
            Case 2000:  Kleur = vbGreen
            Case 3000:  Kleur = vbYellow
        End Select
        Range(Cells(Rij, "A"), Cells(Rij, "E")).Interior.Color = Kleur
        Range("F" & Rij) = Sheets("gino").Range(cel met de te copieren waarde)
    End If
End Sub

 

[ginogcsbelgie]

hartelijk bedankt Cobbe voor de hulp, werkt perfect