3

Bom dia!

Estou tentando criar um VBA adaptado para uma planilha que eu baixei na internet que separa todos os valores de um CEP. Gostaria de pegar a cidade e colar ao lado do CEP na planilha.

Tentei por mim mesmo criar um Macro que faria isso e até funciona, mas eu não sei adaptar o Macro para funcionar em toda a coluna.

Abaixo seguem umas fotos explicando a situação:

inserir a descrição da imagem aqui

inserir a descrição da imagem aqui

inserir a descrição da imagem aqui

inserir a descrição da imagem aqui

Agradeço qualquer ajuda!

1
  • Creio que consegue integrar com os correios para fazer essa pequisa online tb.
    – Evert
    Commented 15/09/2017 às 14:38

2 Respostas 2

2

O Range.Copy será utilizado, pois é simples e fácil. O Select deve ser evitado (inglês) em excel-vba. Caso deseje usar o .Select é recomendado desligar a atualização de tela antes do código iniciar e religar no fim. Application.ScreenUpdating = False e Application.ScreenUpdating = True

Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ThisWorkbook.Sheets("CONSULTAR")
Set ws2 = ThisWorkbook.Sheets("CIDADES")
'Pode usar .Sheets ou .Worksheets, com o nome entre "" ou com o número de index
'Exemplo de index
'Set ws1 = ThisWorkbook.Sheets(3)
'Set ws2 = ThisWorkbook.Worksheets(4)
rLast = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1

ws1.Range("D6").Copy Destination:=ws2.Cells(rLast, 1)
ws1.Range("E14").Copy Destination:=ws2.Cells(rLast, 2)

O código pode ser executado por um botão ou por eventos, por exemplo: mudança na planilha CONSULTAR.

1. Declaração das Planilhas (Worksheet)

Primeiro você declara cada planilha utilizada, para poder copiar de uma para outra

Dim ws1 As Worksheet :Set ws1 = ThisWorkbook.Sheets("CONSULTAR")

2. Obter a última linha

O código ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row obtém a última linha da coluna 1, ou seja, "A". E depois rLast soma 1 para escrever 1 linha depois da última.

rLast = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1

3. Copiar e Colar

ws1.Range("D6").Copy copia a célula D6 da Planilha CONSULTAR

Destination:=ws2.Cells(rLast, 1) cola na coluna 1 ("A") e na linha rLast

ws1.Range("D6").Copy Destination:=ws2.Cells(rLast, 1)

Obs.: Na próxima vez insira o código na formatação correta e não por imagem.

4
  • Muito obrigado pela força. Eu testei de ambas as nossas formas e funcionou. Uma pena que no final o esforço foi em vão, porque assim que eu botei pra rodar na minha lista, tomei IP Block do serviço que cata os CEPs. Hahaha... Acho que não ficaram felizes com tanta busca ao invés de uma só... Commented 14/09/2017 às 16:28
  • @LeonFreire O site de busca de CEP é dos correios? Commented 14/09/2017 às 16:34
  • Não. É que a tabela pronta que busca o CEP utiliza um serviço a partir deste site, que já nem consigo acessar mais aqui do trabalho. Hahaha... Só pelo celular mesmo: viacep.com.br Commented 14/09/2017 às 16:37
  • Infelizmente os Correios vendem este serviço, então deve ter algum mecanismo para desabilitar a busca de CEP para buscas em excesso Commented 14/09/2017 às 16:47
1

Fiquei nas pesquisas aqui e acabei de conseguir fazer da seguinte forma:

Sub Calcular()
'
' Calcular Macro
'
' Atalho do teclado: Ctrl+Shift+C
'

    Dim i As Long
    For i = 2 To Rows.Count

    Sheets("CIDADES").Select
    Range("A" & i).Select

    If ActiveCell.Value = "" Then
        MsgBox "Fim!"
        Exit Sub
    Else

    Selection.Copy
    Sheets("CONSULTAR").Select
    Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("CONSULTAR").Select
    Range("E14:J14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("CIDADES").Select
    Range("B" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    Next i

End Sub

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .