Como estender pesquisa CEP às células subsequentes?

Question

Boa tarde,

Tenho uma pesquisa CEP onde digito o CEP na célula A1 da Planilha Plan1 e ele lança as informações na planilha Plan2, até ai tudo certo!
Mas tenho que fazer uma lista de cep's fazendo mesma coisa nas células abaixo (A2, A3, A4, A5, A6...).

Gostaria de saber se há uma forma mais fácil (e menos pesada pro sistema) de aplicar essa busca por cep nas células A2, A3, A4... sem ser copiando o código novamente e alterar as referências de célula... Ou tem que ser na mão grande mesmo?

O código é esse:

Sub lsPesquisaCEP(ByVal sCEP As String)
    On Error GoTo TratarErro
    
    Range("Plan2!a1:H1").Clear
    
    If sCEP <> "" Then
        With ActiveWorkbook.XmlMaps("webservicecep_Mapa")
            .ShowImportExportValidationErrors = False
            .AdjustColumnWidth = True
            .PreserveColumnFilter = False
            .PreserveNumberFormatting = False
            .AppendOnImport = False
        End With
        ActiveWorkbook.XmlImport URL:= _
            "http://republicavirtual.com.br/web_cep.php?cep=" & sCEP, ImportMap:= _
            Nothing, Overwrite:=False, Destination:=Range("Plan2!$a$1")
            
            
    End If
        
    Calculate
    
Sair:
    Exit Sub
TratarErro:
    MsgBox "CEP não cadastrado!"
    GoTo Sair
    Resume
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then
        lsPesquisaCEP (Target.Value)
    End If
End Sub

Desde já, obrigado.

Answer 1

Sub lsPesquisaCEP(ByVal sCEP As String)
  Dim l As Long
  
  On Error GoTo TratarErro
  
  Range("Plan2!a1:H1").Clear
  
  If sCEP <> "" Then
    For l = 1 To Cells(Rows.Count, "A").End(xlUp).Row
      With ActiveWorkbook.XmlMaps("webservicecep_Mapa")
        .ShowImportExportValidationErrors = False
        .AdjustColumnWidth = True
        .PreserveColumnFilter = False
        .PreserveNumberFormatting = False
        .AppendOnImport = False
      End With
      ActiveWorkbook.XmlImport URL:= _
      "http://republicavirtual.com.br/web_cep.php?cep=" & sCEP, ImportMap:= _
      Nothing, Overwrite:=False, Destination:=Range("Plan2!$a$" & l)
    Next l
  End If
  Calculate
  
Sair:
  Exit Sub
TratarErro:
  MsgBox "CEP não cadastrado!"
  GoTo Sair
  Resume
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$1" Then
    lsPesquisaCEP (Target.Value)
  End If
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Não consegui fazer funcionar aqui Felipe, quando coloco um novo cep em A2 da Plan1, nada aparece na segunda linha da Plan2.

Answer 3

Me desculpe, esqueci a segunda parte:

rivate Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 Then
    lsPesquisaCEP (Target.Value)
  End If
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Muito obrigado. Valeu pela força!