Listbox problemer

Jeg har fået hjælp af Bak igår
og det har hjulpet lidt men der sker stadig at ved et klik på listen opfatter excel det som om jeg har klikket på flere emner i listen.

her er spørgsmål fra igår:
Jeg har en listbox som er inbygget i arket dvs.ikke på formen. Brugeren vælger et emne ad gangen og så kører makro som kopirer nogen række til arket. Men en gang imellem sker det at computer når man klikker på et emne i listen opfatter som om man har klikket flere gange på emnet. Jeg troede at der var noget galt med min mus men det sker også på andre computere dog kun en gang imellem. Makroen kører ellers godt. Hvad kan jeg gøre?
Her er koden:
Public var1 as Variant

Private Sub ListBox1_Click()
    Dim rFound As Range
    Dim rLook As Range
    Dim rValue As String
    Dim rDest As Range
    If listbox1.Value = var1 Then Exit Sub
    rValue = listbox1.Value
    var1 = rValue
    Set rLook = Worksheets("Axe").Range("c2:aw2")
   

    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
        rFound.Resize(44, 1).Copy
        With Worksheets("Ark1")
                    With .Range("IV29").End(xlToLeft).Offset(0, 1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteComments
                        Selection.HorizontalAlignment = xlCenter
                    End With

        End With
       
        End If
     
    Set rLook = Worksheets("Dax").Range("c2:aw2")
   

    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
        rFound.Resize(44, 1).Copy
        With Worksheets("Ark1")
                    With .Range("IV29").End(xlToLeft).Offset(0, 1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteComments
                        Selection.HorizontalAlignment = xlCenter
                    End With

        End With
       
        End If

Set rLook = Worksheets("Rix").Range("c2:aw2")
   

    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
        rFound.Resize(44, 1).Copy
        With Worksheets("Ark1")
                    With .Range("IV29").End(xlToLeft).Offset(0, 1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteComments
                        Selection.HorizontalAlignment = xlCenter
                    End With

        End With
       
        End If
Set rLook = Worksheets("Vix").Range("c2:aw2")
   

    Set rFound = rLook.Find(rValue, , , xlWhole)
    If Not rFound Is Nothing Then
        rFound.Resize(44, 1).Copy
        With Worksheets("Ark1")
                    With .Range("IV29").End(xlToLeft).Offset(0, 1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteComments
                        Selection.HorizontalAlignment = xlCenter
                    End With

        End With
       
        End If

End Sub