Tente fazer abusca com a ajuda dos caracteres coringas

Exemplo com "*" (asterisico)

For Each rng3 In .Range("A2:A" & lr).Find("CONSIGNACOES/DESCONTOS*")

ou então

Dim rng3 as range

On Error Resume Next
        
        For Each rng3 In .Range("A2:A" & lr).Find("CONSIGNACOES/DESCONTOS ")
            If rng3 Is Nothing Then
                Set rng3 = .Range("A2:A" & lr).Find("CONSIGNACOES/DESCONTOS")
               If not rng3 Is Nothing Then
               '   seu cod. aqui  .......
              End If
           end if
        Next
        
        On Error GoTo 0

Basole

Tentei o primeiro nao deu certo erro 424
mas se deixa assim vai

For Each rng3 In .Range("A2:B100" & LR).Find("CONSIGNACOES")

Alguém me ajuda tava funcionando e parou
Ele tava buscando um valor quando encontrava buscava outro mas agr só faz um .find se eu coloca dois da erro 424 helpplease

Private Sub ThirdStep()
            Dim rng As Range
            Dim rng2 As Range
            Dim rng3 As Range
            Dim rng4 As Range
            Dim rng5 As Range
            Dim LR!
            Dim LR1!
            
            
            Plan1.Activate
            
            With Plan2
                LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                
                LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                
                For Each rng In .Range("A1:A" & LR).Find("APLICACOES DIRETAS")
                    With Plan1
                        ' CNPJ :
                        If rng.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, 7, 19))
                        End If
                     
                        ' CEP :
                        If rng.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, VBA.InStr(rng.Value2, "APLICACOES DIRETAS") + 0, 18))
                        End If
                         If rng.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("B" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, VBA.InStr(rng.Value2, "APLICACOES DIRETAS") + 19, 20))
                        End If
                        
                    
                    End With
                        
                    
                        '-----------------O erro acontece nessa linha de baixo ja tentei de Varias formas mais sempre ao adiciona o segundo find da erro 424
                                
                For Each rng2 In .Range("A1:A" & LR).Find("DESPESAS CORRENTES A ANULAR ").Find("APLICACOES DIRETAS")
                    With Plan1
                        ' CNPJ :
                        If rng2.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, 7, 19))
                        End If

                        ' CEP :
                        If rng.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("c" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, VBA.InStr(rng2.Value2, "APLICACOES DIRETAS") + 0, 18))
                        End If
                         If rng.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("d" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, VBA.InStr(rng2.Value2, "APLICACOES DIRETAS") + 19, 20))
                        
                        
                        
                        
                    End If

                        
                    End With
                    
                    
                    

                For Each rng3 In .Range("A" & LR).Find("CONSIGNACOES/DESCONTOS ").Find("CONSIGNACOES/DESCONTOS")
                    With Plan1
                        ' CNPJ :
                        If rng2.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng3.Value2, 7, 19))
                        End If

                        ' CEP :
                        If rng3.Value2 Like "*CONSIGNACOES/DESCONTOS*" Then
                            .Range("e" & LR1).Value = VBA.Trim(VBA.Mid(rng3.Value2, VBA.InStr(rng3.Value2, "CONSIGNACOES/DESCONTOS") + 0, 22))
                        End If
                         If rng3.Value2 Like "*CONSIGNACOES/DESCONTOS*" Then
                            .Range("f" & LR1).Value = VBA.Trim(VBA.Mid(rng3.Value2, VBA.InStr(rng3.Value2, "CONSIGNACOES/DESCONTOS") + 22, 20))
                        End If


                    End With
                    
                    
                    
                     For Each rng4 In .Range("A" & LR).Find("CONSIGNACOES/DESCONTOS ").Find("FATURAS")
                    With Plan1
                        ' CNPJ :
                        If rng4.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, 7, 19))
                        End If

                        ' CEP :
                        If rng4.Value2 Like "*FATURAS*" Then
                            .Range("g" & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, VBA.InStr(rng4.Value2, "FATURAS") + 0, 7))
                        End If
                         If rng4.Value2 Like "*FATURAS*" Then
                            .Range("h" & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, VBA.InStr(rng4.Value2, "FATURAS") + 7, 20))
                        End If


                    End With
                    
                    
                    
                    
                      For Each rng5 In .Range("A" & LR).Find("TOTAIS ").Find("LIQUIDO ")
                    With Plan1
                        ' CNPJ :
                        If rng5.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, 7, 19))
                        End If

                        ' CEP :
                        If rng5.Value2 Like "*LIQUIDO*" Then
                            .Range("i" & LR1).Value = VBA.Trim(VBA.Mid(rng5.Value2, VBA.InStr(rng5.Value2, "LIQUIDO") + 0, 8))
                        End If
                         If rng5.Value2 Like "*LIQUIDO*" Then
                            .Range("j" & LR1).Value = VBA.Trim(VBA.Mid(rng5.Value2, VBA.InStr(rng5.Value2, "LIQUIDO") + 14, 20))
                        End If


                    End With



                 Next 'quinto

                 Next ' quarto
                 Next  'terceiro
                

                 Next  'segundo
                 Next  'primeiro
                
               ' .Cells.Clear
             
            End With
            
            

        End Sub
        

'
        
'

Att Vitor Hugo

Boa noite,

Anexe um planilha de exemplo.
Assim fica mais fácil tentar ajudar.

att,

brunoxro

Boa Noite Obrigado pela ajuda segue arquivo

Att, Vitor Hugo

Boa tarde Vitor,

Olhando seu arquivo, entendi que você quer organizar as informações que estão na Plan2 para a Plan1.
Explique mais detalhadamente que informação deve ser buscada e qual coluna deve ser colocada.

att,

Essa rotina Faz exatamente oque preciso colando e capturando os dados
estou com erro nesta linha

For Each rng2 In .Range("A1:A" & LR).Find("DESPESAS CORRENTES A ANULAR ").Find("APLICACOES DIRETAS")
quando tento duas procuras com .find ele nao reconhece se retira o segundo o codigo passa mas preciso dos dois
porque a primeira .FIND ("DESPESAS CORRENTES A ANULAR ") nunca vai ser igual mais posso te varias APLICACOES DIRETAS que ta no .find 2

Boa noite,

Acredito que o .Find() do VBA não aceite dois em sequência. Ou seja, da forma que você está fazendo não vai funcionar no VBA.
Você pode seguir a sugestanção do Basole acima e fazer duas buscas.

att,

O cod rodou durante 2 dias depois parou
estava desse jeito com 2 .Find()

vitorhsh acredito que se expor melhor sobre o resultado final desejado, seja melhor pois podemos sugerir outras opções ao invés de insistir esse método de 2 find.

Pois como já foi exposto, não se pode trabalhar como o find desta forma.

Vitor, o problema em seu código é de natureza conceitual em relação ao que é ou o que faz (e também o que não faz) o método Find.

Veja o que diz o Help para ele:

Valor de retorno:
Um objeto Range que representa a primeira célula onde essas informações são localizadas.

Duas informações essenciais estão presentes nesse pequeno trecho: a primeira é que o método Find retorna um Range. A segunda é que retorna uma célula só.

Da primeira informação acima, decorre então que, se o primeiro Find não encontrar nada, vai retornar Nothing e não um Range, aí o segundo Find vai falhar, pois não há um objeto Range válido onde aplicar o método, concorda?

Em relação a segunda informação e analisando seu seu código, embora seja possível não faz sentido nenhum usar um For Each - Next para um range que vai retornar uma célula só, não é mesmo? É uma pena mas o método Find não retorna um range com todas as células que atenderam ao critério como vc deseja.

Tendo isso em mente, usar dois (ou mais) .Find só irá funcionar quando todos os critérios de cada um dos Find forem atendidos ao mesmo tempo na mesma célula, caso contrário ou gera erro se o(s) primeiro(s) Find não for(em) atendido(s) ou retorna Nothing se o último não corresponder.

Então quando vc afirmou que

O cod rodou durante 2 dias depois parou ...estava desse jeito com 2 .Find()

A única possibilidade é que uma mesma célula estava atendendo aos dois critérios.

Para seguir pesquisando uma String num intervalo dá pra usar o FindNext e testar já não voltou à célula original novamente.

Outro erro que pode ter passado despercebido e que também está no código do arquivo que vc anexou:
For Each rng In .Range("A" & LR).Find("APLICACOES DIRETAS")

Onde talvez sua intenção era:
For Each rng In .Range("A1:A" & LR).Find("APLICACOES DIRETAS")
--------------
Obs.: extrair dados desse tipo de txt ou pdf não muito estruturado no VBA seria muito mais fácil fazer usando Expressões Regulares (RegExp).

Boa Tarde Familia,

Primeiramente gostaria de agradecer a todos que responderam,
especialmente ao EdsonBR, com essa belíssima explicação sobre o método find
peço desculpas pela demora,
Não sou crack em VBA então algumas funções não consigo aplicar
Gotartia de uma função que quando encontrar na coluna [A] .find("DESPESAS CORRENTES") ele procurasse .find("APLICACOES DIRETAS")
porq eu preciso que classifica o primeiro .find("DESPESAS CORRENTES") para acha .find("APLICACOES DIRETAS")
por causa da segunda consulta que vai te em comum o nome "APLICACOES DIRETAS"
o que diferencia uma APLICACOES DIRETAS da outra APLICACOES DIRETAS e o primeiro .find um sera ("DESPESAS CORRENTES") e o outro ("DESPESAS CORRENTES A ANULAR")

vitorhsh acredito que se expor melhor sobre o resultado final desejado.

Exp 1º consulta
.find("DESPESAS CORRENTES") encontrou vai para .find("APLICACOES DIRETAS") retorna o valor
2º consulta
.find("DESPESAS CORRENTES A ANULAR") encontrou vai para .find("APLICACOES DIRETAS") retorna o valor

qual método posso utiliza pra fazer esse busca ?
eu fiz um GATO no Cod. funciona mais com % de erro mt grande
fiz o seguinte descartei o primeiro .find("DESPESAS CORRENTES") e vou direto na "APLICACOES DIRETAS"
depois que a rotina faz o procedimento pra 1º consulta apago a linha da primeira consulta "APLICACOES DIRETAS" e vou
para 2º consulta. porque apaga os dados? porq se nao ele retorna o valor da primeira consulta na segunda pois ambos tem em comum "APLICACOES DIRETAS"
a unica coisa que diferencia uma aplicação direta da outra e o ("DESPESAS CORRENTES") e a outra e ("DESPESAS CORRENTES A ANULAR")

Segue o cod que estou utilizando

Sub Importa_PDF_Start()
Application.DisplayAlerts = False
    Dim AdobeApp As String
    Dim AdobeFile As String
    Dim StartAdobe
    '         ALTERE O CAMINHO (DIRETORIO) DO SEU ADOBE READER SE NECESSARIO
    AdobeApp = "C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe"
    AdobeFile = ThisWorkbook.Path & "FOLHA ARQUIVO NACIONAL DDP.pdf"
    
    StartAdobe = VBA.Shell("" & AdobeApp & " " & """" & AdobeFile & """" & "", 1)
    
    Application.OnTime Now + TimeValue("00:00:04"), "FirstStep"
End Sub
Private Sub FirstStep()
Application.DisplayAlerts = False
    SendKeys ("^a")
    SendKeys ("^c")
    
    Application.OnTime Now + TimeValue("00:00:04"), "SecondStep"
    
End Sub

Private Sub SecondStep()
Application.DisplayAlerts = False
Plan2.Activate
Range("A1").Select
Dim ws As Worksheet

    SendKeys ("^v")
    'AppActivate "Microsoft Excel"
    On Error Resume Next
     AppActivate Application.Caption
    On Error GoTo 0
    'AppActivate "Excel"
   With ThisWorkbook
   .Activate
    If .Sheets.Count < 2 Then
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    End If
    .Sheets(2).Activate
    End With
    Range("A1").Activate
    SendKeys ("^v")
   
    Application.OnTime Now + TimeValue("00:00:03"), "ThirdStep"
    
End Sub
Private Sub ThirdStep()
Application.DisplayAlerts = False
            Dim rng As Range
            Dim rng2 As Range
            Dim rng3 As Range
            Dim rng4 As Range
            Dim rng5 As Range
            Dim LR!
            Dim LR1!
            Dim rng8
            
            Plan1.Activate
            
            With Plan2
                LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                
                LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                'Plan2.Activate
                ' For rng = LR To .Range("A" & LR).Find("APLICACOES DIRETAS").Find("APLICACOES DIRETAS")
                   For Each rng In .Range("A1:A" & LR).Find("APLICACOES DIRETAS") '.Find("APLICACOES DIRETAS")
                
                    With Plan1
                        ' CNPJ :
                        If rng Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, 7, 19))
                        End If
                     
                        ' CEP :
                        If rng.Value2 Like "*APLICACOES DIRETAS*" Then
                       
                         .Range("b5,b5" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, VBA.InStr(rng.Value2, "APLICACOES DIRETAS") + 0, 19))
                        End If
                         If rng.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("C5,C5" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, VBA.InStr(rng.Value2, "APLICACOES DIRETAS") + 19, 20))
                        End If
                        
                    
                    End With
                    Plan2.Activate
                    
                    Range("A3:A20").ClearContents
                    
           
                   For Each rng2 In .Range("A2:B100" & LR).Find("*APLICACOES DIRETAS*")
                     
 With Plan1
                        ' CEP :
                        If rng2.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("d5,d5" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, VBA.InStr(rng2.Value2, "APLICACOES DIRETAS") + 0, 18))
                        End If
                         If rng2.Value2 Like "*APLICACOES DIRETAS*" Then
                            .Range("e5,e5" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, VBA.InStr(rng2.Value2, "APLICACOES DIRETAS") + 19, 20))
                        
                        
                    
                        
                    End If

                        
                    End With
                    
                    
                    

                For Each rng3 In .Range("A1:b100" & LR).Find("CONSIGNACOES INDIVIDUALIZADAS")
                    With Plan1
                        ' CNPJ :
                        If rng3.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng3.Value2, 7, 19))
                        End If

                        ' CEP :
                        If rng3.Value2 Like "*CONSIGNACOES INDIVIDUALIZADAS*" Then
                            .Range("F5,f5" & LR1).Value = VBA.Trim(VBA.Mid(rng3.Value2, VBA.InStr(rng3.Value2, "CONSIGNACOES INDIVIDUALIZADAS ") + 0, 32))
                        End If
                         If rng3.Value2 Like "*CONSIGNACOES INDIVIDUALIZADAS*" Then
                            .Range("g5,g5" & LR1).Value = VBA.Trim(VBA.Mid(rng3.Value2, VBA.InStr(rng3.Value2, "CONSIGNACOES INDIVIDUALIZADAS ") + 29, 20))
                        End If


                    End With
                    
                    
                    
                     For Each rng4 In .Range("A1:b1000" & LR).Find("FATURAS")
                    With Plan1
                        ' CNPJ :
                      

                        ' CEP :
                        If rng4.Value2 Like "*FATURAS*" Then
                         '   .Range(h5, h5 & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, VBA.InStr(rng4.Value2, "FATURAS") + 0, 7))
                            
                            .Range("h5,h5" & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, VBA.InStr(rng4.Value2, "FATURAS") + 0, 7))
                       
                        End If
                         If rng4.Value2 Like "*FATURAS*" Then
                            .Range("i5,i5" & LR1).Value = VBA.Trim(VBA.Mid(rng4.Value2, VBA.InStr(rng4.Value2, "FATURAS") + 8, 20))
                        End If


                    End With
                    
                    
                     Plan2.Activate
                    
                
                    
                      For Each rng5 In .Range("A1:b1000" & LR).Find("LIQUIDO")
                    With Plan1
                        
                       

                        ' CEP :
                        If rng5.Value2 Like "*LIQUIDO*" Then
                            .Range("j5,j5" & LR1).Value = VBA.Trim(VBA.Mid(rng5.Value2, VBA.InStr(rng5.Value2, "LIQUIDO") + 0, 8))
                        End If
                         If rng5.Value2 Like "*LIQUIDO*" Then
                            .Range("k5,k5" & LR1).Value = VBA.Trim(VBA.Mid(rng5.Value2, VBA.InStr(rng5.Value2, "LIQUIDO") + 8, 28))
                        End If


                    End With



                 Next 'quinto

                 Next ' quarto
                 Next  'terceiro
                

                 Next  'segundo
                 Next  'primeiro
                
               ' .Cells.Clear
               
               
               
                .Range("A73:A83").ClearContents
      
             
            End With
            '-----Pensionista
              Plan1.Activate
            
            With Plan2
                LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                
                LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                
                   For Each rng In .Range("A1:b1000" & LR).Find("FATURAS")
                    With Plan1
                        ' CNPJ :
                        If rng.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("A" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, 7, 19))
                        End If
                     
                        ' CEP :
                        If rng.Value2 Like "*FATURAS*" Then
                            .Range("h8,h8" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, VBA.InStr(rng.Value2, "FATURAS") + 0, 8))
                        End If
                         If rng.Value2 Like "*FATURAS*" Then
                            .Range("i8,i8" & LR1).Value = VBA.Trim(VBA.Mid(rng.Value2, VBA.InStr(rng.Value2, "FATURAS") + 8, 15))
                        End If
                        
                    
                    End With
                        
                    
                           .Range("A93:A104").ClearContents
                                
                For Each rng2 In .Range("A1:a1000" & LR).Find("LIQUIDO")
                    With Plan1
                        ' CNPJ :
                        If rng.Value2 Like "CNPJ :*" Then
                            LR1 = Plan1.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
                            .Range("j8,j8" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, 7, 19))
                        End If

                        ' CEP :
                        If rng2.Value2 Like "*LIQUIDO*" Then
                            .Range("j8,j8" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, VBA.InStr(rng2.Value2, "LIQUIDO") + 0, 8))
                        End If
                         If rng2.Value2 Like "*LIQUIDO*" Then
                            .Range("k8,k8" & LR1).Value = VBA.Trim(VBA.Mid(rng2.Value2, VBA.InStr(rng2.Value2, "LIQUIDO") + 7, 20))
                        
                        
                    
                        
                    End If

                        
                    End With
                    
                    
                    
                    


                 Next  'segundo
                 Next  'primeiro
                
                .Cells.Clear
             
            End With
            Application.OnTime Now + TimeValue("00:00:04"), "FirstSteat2"
            'Call ThirdSteppencio

        End Sub
        
        Private Sub FirstSteat2()

    Application.OnTime Now + TimeValue("00:00:06"), "Importa_PDF_StartCADE"

End Sub
'

vitorhsh
é coisa de trabalho ?
pague um profissional para fazer
vai poupar muitas dores de cabeça, e economizar tempo que poderia ser gasto em outros assuntos

quer fazer vc mesmo?
vai ter que ir no passo a passo no que funciona e oq não, e aprender a usar as funções
uma opinião é deixar de usar find e usar funções de string do vba , podendo até misturar funções de texto do excel em coluna auxiliar

quer depender de outros?
vai ter que ser claro e resumido no que quer sem dar voltas ao assunto "eu que fazia isso , nunca era respondido"
explique de forma clara as informações chaves e as que tem que ir para a outra aba

Boa Tarde EdCronos2

Obrigado pela atenção como disse no Repost o primeiro Topico (Refiz ele todinho ontem anoite) e coloquei um arquivo mas atualizado
reparei que vc baixo o arquivo antigo esse poste foi criado no la pelo mes 3 desde de então venho trabalhando nessa rotina, ela não e uma coisa pra ser gasta dinheiro
e mas pra aprende, se não quisesse o Auxilio ou como você disse da dependência dos colegas do fórum eu não estaria aqui pedindo,
agradeço pela dica irei aprimora meus conhecimentos na função string se quiser da uma olhada no arquivo atualizado ele e esta no primeiro post

Att, Vitor Hugo