Neste exemplo seu o loop nao demora muito mais que 3 segundos, vale a pena reduzir esse tempo?

Se fosse algo de 100000 linhas ate seria justificavel, mas 100 garanto nao vai fazer diferença.

Bom dia wessley,

Vê se ajuda:

Option Explicit

Public Sub Busca()
Dim wsIndex     As Worksheet
Dim UltL        As Long
Dim Lin         As Long
Dim i           As Long

    Application.ScreenUpdating = False
    Set wsIndex = ThisWorkbook.Worksheets("Plan1")
    
    UltL = Application.WorksheetFunction.Max(2, wsIndex.Cells(Rows.Count, 8).End(xlUp).Row)
    wsIndex.Range("H2:K" & UltL).ClearContents
    UltL = wsIndex.Cells(Rows.Count, 1).End(xlUp).Row
    Lin = 2
    
    For i = 2 To UltL
        If InStr(1, UCase(wsIndex.Cells(i, 2).Value), UCase(wsIndex.Cells(1, 6).Value)) > 0 Then
            wsIndex.Cells(Lin, 8).Value = wsIndex.Cells(i, 1).Value
            wsIndex.Cells(Lin, 9).Value = wsIndex.Cells(i, 2).Value
            wsIndex.Cells(Lin, 10).Value = wsIndex.Cells(i, 3).Value
            wsIndex.Cells(Lin, 11).Value = wsIndex.Cells(i, 4).Value
            Lin = Lin + 1
        End If
    Next i

    Set wsIndex = Nothing
    Application.ScreenUpdating = True

End Sub

Qualquer coisa da o grito.
Abraço

Caro colega MPrudencio o que eu disse foi um exemplo, porem ontem eu trabalho na usina, tem arquivo que tem mais de 20 mil linhas por isso preciso de um codigo rapido, fui claro ? Muito obrigado pela atenção e colaboração

Muito obrigado Bernardo seu código foi muito rápido mesmo, outra duvida, e se eu quisesse procurar pelas colunas A,B,C,D pelo critério digitado na célula F1 ??