Bereik benoemen in code

[Roma]

Harry,
Perfect werkt op alle tabbladen, je bent toch een geduldig mens met mij.
Alleen de codes(diensten) werken nog op het hele tabblad

 

[HSV]

Beveilig eerst alle bladen eens.

 

[Roma]

Harry,
Op elk tabblad ongeveer 50 stuks kan ik deze diensten invoeren. Er zitten tabbladen bij waar altijd nog gegevens moeten worden ingevuld.
Als je dat dan wilt doen dan wordt de foutmelding gegeven die in de code staat.
Zo ook op de tabbladen KWART 1 2 3 en 4 worden nog andere gegevens ingevuld.
Het is dus van belang dat het bereik wordt aangegeven.

 

[HSV]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[COLOR=#FF0000]If Not Intersect(Target, Range("C9:AG43, C53:AG87, C96:AG130")) Is Nothing Then[/COLOR]
    With Sheets("Kleur").Range("C7:G32")
        Set c = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
       ActiveSheet.Unprotect ""
        If Not c Is Nothing Then
            Target.Interior.Color = c.Interior.Color
'            Target.Offset(44).Interior.Color = c.Interior.Color
'            Target.Offset(87).Interior.Color = c.Interior.Color
        Else
            Target.Interior.Color = xlNone
           MsgBox "Je hebt een ongeldige code gekozen." & vbNewLine & "Kies een andere code.", vbExclamation, "Kleurencode."
            Target.Value = ""
        End If
      ActiveSheet.Protect ""
    End With
   [COLOR=#FF0000] End If[/COLOR]
End Sub

 

[Roma]

Harry,
Geweldig je hebt het voor elkaar gekregen. Je bent een supermens. Het bereik op de 4 tabbladen zijn benoemd chapeau.
Alleen op andere tabbladen kan ik nog steeds niets invoeren. Hij neemt het bereik mee op andere tabbladen.
Ron

 

[HSV]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If WorksheetFunction.Or(Sh.Name = "KWART1", Sh.Name = "KWART2", Sh.Name = "KWART3", Sh.Name = "KWART4") Then
If Not Intersect(Target, Range("C9:AG43, C53:AG87, C96:AG130")) Is Nothing Then
    With Sheets("Kleur").Range("C7:G32")
        Set c = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
       Sh.Unprotect ""
        If Not c Is Nothing Then
            Target.Interior.Color = c.Interior.Color
'            Target.Offset(44).Interior.Color = c.Interior.Color
'            Target.Offset(87).Interior.Color = c.Interior.Color
        Else
            Target.Interior.Color = xlNone
           MsgBox "Je hebt een ongeldige code gekozen." & vbNewLine & "Kies een andere code.", vbExclamation, "Kleurencode."
            Target.Value = ""
        End If
       Sh.Protect ""
    End With
    End If
  End If
End Sub

 

[Roma]

Harry de Superman.
Het werkt als een speer. Ik weet niet hoe ik je moet bedanken voor al je geduld en moeite die je hebt gedaan voor mij.
Nogmaals hartelijk dank voor al je hulp. Voor straf heb ik een donatie gedaan bij HELPMIJ.NL
Dank
Ron

 

[HSV]

Graag gedaan Ron, en een mooi gebaar naar Helpmij.nl. :thumb:
Daar zijn ze altijd blij mee natuurlijk.