3
Good morning!
I am trying to create a VBA adapted to a spreadsheet that I downloaded on the internet that separates all values of a zip code. I’d like to take the city and stick it next to the zip code on the spreadsheet.
I tried by myself to create a Macro that would do this and even works, but I do not know how to adapt the Macro to work throughout the column.
Below are some pictures explaining the situation:
I appreciate any help!
2
The Range.Copy will be used as it is simple and easy. The Select should be avoided (English) in excel-vba. If you want to use .Select it is recommended to turn off the screen update before the code start and restart at the end. Application.ScreenUpdating = False and 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)
Code can be executed by a button or by events, for example: change in worksheet.
1. Worksheet Declaration (Worksheet)
First you declare each worksheet used, to be able to copy from one to another
Dim ws1 As Worksheet :Set ws1 = ThisWorkbook.Sheets("CONSULTAR")
2. Get the last line
The code ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row gets the last row in column 1, that is "A". And then rLast sum 1 to write 1 line after last.
rLast = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
3. Copy and Paste
ws1.Range("D6").Copy copy cell D6 from Sheet QUERY
Destination:=ws2.Cells(rLast, 1) glue in column 1 ("A") and row rLast
ws1.Range("D6").Copy Destination:=ws2.Cells(rLast, 1)
Obs.: Next time insert the code in formatting correct and not by image.
Thank you so much for the strength. I tested both of our forms and it worked. A pity that in the end the effort was in vain, because as soon as I put to run in my list, I took IP Block of the service that picks the Ceps. Hahaha... I guess they weren’t happy with all the searching instead of one...
@Leonfreire The ZIP code search site is from the post office?
No. Is that the ready table that searches the zip code uses a service from this site, I can not even access here anymore work. Hahaha... Only by cell phone: viacep.com.br
Unfortunately the Post office sell this service, then there must be some mechanism to disable the zip code search for excessive searches
1
I stayed in the polls here and I just managed to do it this way:
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
Browser other questions tagged excel vba
You are not signed in. Login or sign up in order to post.
I believe that can integrate with the post office to make this survey online also.
– Evert