Veja se é isto e se consegue adaptar.

Tem um modelo para baixar:
http://guiadoexcel.com.br/consultar-xml

Veja este tópico tambem:
BASE CEP BRASIL - modelo de busca em VBA
viewtopic.php?f=10&t=6066

Boa-noite
Mauro, não consegui adaptar. Em uma coluna tenho 5.000 endereços e não tem cep, queria adaptar essa macro para buscar o endereço da (0, 1) e achar o cep na internet e jogar em uma coluna qualquer e "Next". Eu sei que no site dos correios dá para pesquisar o cep digitando o endereço.

Att,

Francisco

Baixe este exemplo (anexo), veja se lhe atende..

Bom-dia...Basole
É isso... Só vou tentar adaptar da forma que preciso que é pegar a coluna já com os endereços e a macro pesquisar um a um e jogar o cep na frente.
Se eu não conseguir, dou um grito
Att,

Francisco

Boa-noite
Basole, apesar de fazer poucas tentativas, não consegui fazer o código rodar da maneira que eu esperava.

Francisco,
Post um exemplo da sua planilha, com alguns dados...por favor.

Bom-dia
Segue anexo...

att,

Francisco

Francisco,
No seu exemplo nao tem a coluna com o conteudo da UF (sigla do estado), que é necessario para incluir na pesquisa pelo endereço.

Baixe este exemplo (anexo), veja se lhe atende..

achei legal sua planilha, dai baixei mas deu um erro na sua macro.

Impossivel abrir :

https://viacep.com.br/ws/ " & [A2].Value & "/" & _
Replace([B2].Value, " ", "%20") & "/" & Replace([C2].Value, " ", "%20") & "/xml/", Destination:=Range("F2"))

e para aqui:

.Refresh BackgroundQuery:=False

Andre

Boa-tarde
Foi mal Basole, nem me atentei a esse detalhe...!

achei legal sua planilha, dai baixei mas deu um erro na sua macro.
Impossivel abrir :
https://viacep.com.br/ws/ " & [A2].Value & "/" & _
Replace([B2].Value, " ", "%20") & "/" & Replace([C2].Value, " ", "%20") & "/xml/", Destination:=Range("F2"))
e para aqui:
.Refresh BackgroundQuery:=False

Este erro é causado pela virgula contida no logradouro: [ R DAS LARANJEIRAS, 470 ]
Altere este trecho do codigo, que tambem vai "retirar" a barra "/" caso ocorra :

VBA.Replace(VBA.Replace(VBA.Replace([C2].Value, " ", "%20"), ",", ""), "/", " ")

Boa-noite Basole,
Consegue adaptar a macro na planilha que enviei, coloquei exemplo com "UF" só não retirei a virgula.

att

Francisco

achei legal sua planilha, dai baixei mas deu um erro na sua macro.
Impossivel abrir :
https://viacep.com.br/ws/ " & [A2].Value & "/" & _
Replace([B2].Value, " ", "%20") & "/" & Replace([C2].Value, " ", "%20") & "/xml/", Destination:=Range("F2"))
e para aqui:
.Refresh BackgroundQuery:=False

Este erro é causado pela virgula contida no logradouro: [ R DAS LARANJEIRAS, 470 ]
Altere este trecho do codigo, que tambem vai "retirar" a barra "/" caso ocorra :

VBA.Replace(VBA.Replace(VBA.Replace([C2].Value, " ", "%20"), ",", ""), "/", " ")

Nao entendi, poderia passar o codigo inteiro ?

Grato

fcarlos, os colaboradores do Forum ajudam voluntariamente e dependem de tempo disponível, e se ver nas regras, não devemos ficar cobrando, se quiser envie msg em PVT ao mesmo.

Voltando a rotina do colega Basole, fiz uns ajustes, cole-a em seu modelo e veja se da certo.

Ressalto que pela quantidade de endereços que possui, o código ficará bem lento, e fiz alguns testes com alguns endereços de seu modelo e pelos resultados, alguns não retornam o CEP devido as abreviaturas e tambem pelo acento, por exemplo :
R CEARA não temos o cep, mas Rua Ceará - sim
Tem outros endereços que não retornam, então deverá de consultar no site para ver como está, outro exemplo é :
R PE ROLIM desta forma não é localizado e nem se escrever por extenso, mas se colocar Santa Efigênia em vez de Belo Horizonte temos o CEP, mas não sei se é o correto.

Teste a rotina e depois vemos as particularidades e erros.

Sub Pesquisa_Endereco_Basole()
'Por Basole@hptmail.com
Dim i As Long
Dim xEnds
Dim msg As String
Dim vUF_A As String
Dim vCid_B As String
Dim vLogra_C As String
Dim sRG As Range
Dim ultLin

ultLin = Range("A" & Rows.Count).End(xlUp).Row

Set sRG = Range("A2" & ":" & "A" & ultLin)

    Application.ScreenUpdating = False
    
For Each xEnds In sRG
    
    Sheets("Cep").Range("F3:J14").ClearContents
     
    vUF_A = xEnds 'UF col A
    vCid_B = xEnds.Offset(, 1) 'Cidade Col B
    vLogra_C = xEnds.Offset(, 2) 'Logradouro col C
     
    With ActiveSheet.QueryTables.Add(Connection:="Url;https://viacep.com.br/ws/" & [vUF_A] & "/" & _
        Replace([vCid_B], " ", "%20") & "/" & VBA.Replace(VBA.Replace(VBA.Replace([vLogra_C], " ", "%20"), ",", ""), "/", " ") & "/xml/", Destination:=Range("F2"))
        .RefreshStyle = xlOverwriteCells
        .SaveData = True
        .Refresh BackgroundQuery:=False
    
    End With
    
    i = 7
        With Sheets("Cep")
            .Activate
            Calculate
            Application.Wait (Now + #12:00:03 AM#)
            Application.StatusBar = "Aguarde o processamento ..."
                   
                msg = IIf(.Cells(5, 1).Value = "<resultado>0</resultado>", "Cep nao encontrado!", "Ok, sucesso!" & _
                vbNewLine & Replace(Replace(.Cells(6, 9).Value, "<cep>", ""), "</cep>", ""))
                   
                xEnds.Offset(, 3) = Replace(Replace(.Cells(6, 9).Value, "<cep>", ""), "</cep>", "")
                  
            .Range("F2:J17").ClearContents
            Application.StatusBar = .[xfd1]
        
        End With
        
        Application.ScreenUpdating = True

Next xEnds
    
    Application.ScreenUpdating = True

End Sub