Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("b2:b1000")) Is Nothing Then
    If Target.Value <> "" Then Exit Sub
    UserForm1.Show
End If
End Sub

Option Explicit

Option Compare Text

Private sh As Worksheet

Private Sub ListBox1_Click()
ActiveCell.Value = UserForm1.ListBox1.Value
UserForm1.TextBox1.Value = ""
UserForm1.Hide
End Sub

Private Sub TextBox1_Change()
Call mCaricaListBox("FiltraDati")
End Sub

Private Sub UserForm_Initialize()
    Set sh = ThisWorkbook.Worksheets("Foglio2")
    Call mCaricaListBox("CaricaDati")
End Sub


Private Sub mCaricaListBox(ByVal s As String)

    Dim lRiga As Long
    Dim lng As Long
    
    With sh
        lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
    
    With Me.ListBox1
        If s = "CaricaDati" Then
            For lng = 1 To lRiga
                .AddItem (sh.Range("A" & lng).Value)
            Next
        ElseIf s = "FiltraDati" Then
            .Clear
            For lng = 2 To lRiga
                If InStr(sh.Range("A" & lng).Value, Me.TextBox1.Text) Then
                    .AddItem sh.Range("A" & lng).Value
                End If
            Next
        End If
    End With
    
End Sub


Private Sub UserForm_Terminate()
    Set sh = Nothing
End Sub

Private Sub UserForm_Initialize()
    For a = 2 To 65536
    If Foglio1.Cells(a, 2) = "" Then Exit For
    ListBox1.AddItem Foglio1.Cells(a, 2)
    Next
End Sub



Private Sub TextBox1_Change()
Dim a As Long
Dim b As Long
Dim lung As Integer
Dim lunstr As Integer
lung = Len(TextBox1.Value)
ListBox1.Clear
For a = 2 To 65536
If Foglio1.Cells(a, 2) = "" Then Exit For
lunstr = Len(Foglio1.Cells(a, 2))
    For b = 1 To lunstr
        If Mid(Foglio1.Cells(a, 2), b, lung) = TextBox1.Value Then
        ListBox1.AddItem Foglio1.Cells(a, 2)
        Exit For
        End If
    Next
Next
End Sub



Private Sub ListBox1_Click()
Dim a As Long
Dim b As Long
Dim c As Long
Dim matrice()
Dim lung As Long
lung = ListBox1.ListCount - 1
ReDim matrice(lung, 12)
Dim valore As String
    For a = 0 To ListBox1.ListCount - 1
    valore = ListBox1.List(a)
    
        For b = 2 To 65536
        If Foglio1.Cells(b, 2) = "" Then Exit For
        If Foglio1.Cells(b, 2) = valore Then
            For c = 1 To 13
            matrice(a, c - 1) = Foglio1.Cells(b, c)
            Next
        End If
        Next
    Next
    Foglio2.Select
    Foglio2.Cells.Clear
    For a = 1 To 13
    Foglio2.Cells(1, a) = Foglio1.Cells(1, a)
    Next
    
    For b = 2 To lung + 2
        If Foglio2.Cells(b, 1) = "" Then
            For c = 1 To 13
            Foglio2.Cells(b, c) = matrice(b - 2, c - 1)
            Next
        End If
    Next
Unload Me
End Sub

Dim ur as Long
ur = cells(Rows.Count, 2).End(xlUp).Row
For a = 2 to ur
......
Next a