فورم بحث في نطاق تصفية

Sub TxtFind1_Change()

Dim ws As Worksheet: Set ws = Sheets(1)

Dim I As Integer, v As Integer

Dim C As Range

Dim Rng As Range



For I = 1 To Col

Me.Controls("Txt" & I).Value = ""

Next I



ws.Activate

Lst1.Clear



Set Rng = Range("B6:B" & Range("B" & Rows.Count).End(xlUp).Row)



Rng.AutoFilter Field:=1, Criteria1:="=" & TxtFind1 & "*"



On Error Resume Next



For Each C In Rng.SpecialCells(xlCellTypeVisible)

    If TxtFind1.Value = "" Then GoTo Finish:

        If C Like TxtFind1 & "*" Then

            Lst1.AddItem

                For I = 0 To Col

                    Lst1.List(v, I) = Cells(C.Row, I + 1)

                Next I

            v = v + 1

        End If

Next C

Finish:

ws.AutoFilterMode = False

End Sub

Rng.AutoFilter Field:=1, Criteria1:="=" & TxtFind1 & "*"

Rng.SpecialCells(xlCellTypeVisible)