listbox para selecionar o nome ou o serviço não copia o valor

Question

Estou fazendo um organograma no excel. a folha é dividida em páginas de 70 linhas. na primeira "página" pode digitar um nome ou serviço, e a caixa de listagem apropriada sob a célula a ser preenchida, mostra todos os nomes de acordo com o que é digitado. por alguma razão, algo está errado na parte do evento da troca de folhas:

onde eu errei? obrigado, pete da Bélgica

isto é o que eu tenho:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If LCase(Sh.Name) = "seniorama" Then
If Not Intersect(Target, Sheets("seniorama").Range("vrwnaam")) Is Nothing
Then
Sheets("lijst").Range("filterlijstkeuze").Value =
Sheets("seniorama").Range("vrwnaam").Value
End If
If Not Intersect(Target, Sheets("seniorama").Range("dienstnaam")) Is
Nothing Then
Sheets("diensten").Range("dienstenlijstkeuze").Value =
Sheets("seniorama").Range("dienstnaam").Value
    End If
End If
End Sub

Private Sub ListBox1_Click()
Dim zoekpersoon As String
Application.ScreenUpdating = False
zoekpersoon = UCase(ListBox1.Value)
' ga naar pagina invulfiche
ActiveWindow.ScrollRow = Range("personen").Row
Range("invulnaam").Value = zoekpersoon
Application.ScreenUpdating = True
fotokiezen
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("seniorama").Select
If Not Intersect(Target, Range("invulnaam")) Is Nothing Then ' als op fiche
naam ingevuld dan foto
fotokiezen
End If
If Not Intersect(Target, Range("vrwnaam")) Is Nothing Then ' oplichting
selectie om te tikken
Range("vrwnaam").Interior.ColorIndex = 6
Range("dienstnaam").Interior.ColorIndex = 16
End If
If Not Intersect(Target, Range("dienstnaam")) Is Nothing Then
Range("dienstnaam").Interior.ColorIndex = 6
Range("vrwnaam").Interior.ColorIndex = 16
End If