Loop na planilha

Question

Pessoal, bom dia!

tenho essa macro de busca que um amigo me ajudou:

ela busca todas as palavra em ART. 152 , artigo 114, art. 221 e ARTIGO 38

1° Porem, quando a palavra é ART.152 , artigo.114, art.221 e ARTIGO.38 com o ponto junto da palavra ela não puxa.

2° Gostaria q a macro fizesse um loop na coluna A até a ultima linha da planiha, pq ela tem em média 20.000 linhas e que a resposta viesse normalmente como vem nas colunas no lado, resumindo: ela está fixa somente em uma célula e não está percorrendo...

alguém poderia me ajudar adaptar ela? 

Sub ExtraiArtigos()
Dim wrdTexto() As String, i As Long, strg As String, k As Long
Dim strTexto As String
strTexto = Replace(Replace([A2], ",", " "), "º", "º ")
wrdTexto() = Split(strTexto)
For i = LBound(wrdTexto) To UBound(wrdTexto) - 1
If InStr(1, wrdTexto(i), "art") > 0 Or InStr(1, wrdTexto(i), "ART") > 0 And _
IsNumeric(Left(wrdTexto(i + 1), 1)) Then
Cells(1, k + 2) = wrdTexto(i) & " " & wrdTexto(i + 1): k = k + 1
End If
Next i
End Sub

Obrigado

segue planilha em anexo

Answer 1

consegui!!! Sub ExtraiArtigos() Dim wrdTexto() As String, strTexto As String Dim i As Long, k As Long, lRow As Long, x As Long 'Determina o numero delinhas preenchidas na coluna A lRow = Cells(Cells.Rows.Count, "E").End(xlUp).Row k = 0 'inicia loop para leitura da coluna A For x = 2 To lRow strTexto = Replace(Replace(Cells(x, "E"), ",", " "), "º", "º ") strTexto = Replace(Replace(Cells(x, "E"), ".", ". "), " ", " ") wrdTexto() = Split(strTexto) For i = LBound(wrdTexto) To UBound(wrdTexto) - 1 If InStr(1, UCase(wrdTexto(i)), "ART.") > 0 Or InStr(1, UCase(wrdTexto(i)), "ART") > 0 And _ IsNumeric(Left(wrdTexto(i + 1), 1)) Then Cells(x, k + 6) = wrdTexto(i) & " " & wrdTexto(i + 1): k = k + 1 End If Next i k = 0 Next x MsgBox "Artigos Extraídos com sucesso!" End Sub