Usuário com melhor resposta
Como estender pesquisa CEP às células subsequentes?

Pergunta
-
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.
Respostas
-
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
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 20 de dezembro de 2014 11:06
Todas as Respostas
-
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
-
-
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
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 20 de dezembro de 2014 11:06
-