I'm working with an excel sheet that converts addresses from one format to another, pastes it in a sheet, and is then supposed to paste the correctly formatted addresses into the next available row in a master sheet of addresses that has thousands of records. There could be hundreds of addresses that need to be pasted to the master sheet, so I'm trying to avoid limiting my rows and ranges by specific references for example a range like ("A2:A6790") would not work because the lists can get long in both the conversion sheet and the master sheet. In the example below I use just one address but I need the code to be able to copy paste all the rows that have data (but not the header): I need the highlighted row to copy to here:
I had to black out some of the addresses for privacy reasons, but I highlighted the row count to show how many records there are.
Here's my code:
`
Private Sub Convert()
Dim sap As Worksheet: Set sap = Sheets("SAP")
Dim con As Worksheet: Set con = Sheets("CONVERSION")
Dim abrv As Worksheet: Set abrv = Sheets("ABRV")
Dim slip As Worksheet: Set slip = Sheets("SLIP")
Dim ads As Worksheet: Set ads = Sheets("ADS")
Dim adsrng As Range: Set adsrng = ads.Range("B:B")
Dim conads As Range: Set conads = con.Range("W:W")
Dim saprngQW As Range: Set saprngQW = sap.Range("q:w")
Dim conrngOU As Range: Set conrngOU = con.Range("o:u")
Dim saprngDO As Range: Set saprngBO = sap.Range("B:O")
Dim conrngBN As Range: Set conrngBN = con.Range("B:N")
Dim sapcity2 As Range: Set sapcity2 = sap.Range("o:o")
Dim concity2 As Range: Set concity2 = con.Range("x:x")
Dim sapunion As Range: Set sapunion = Union(saprngQW, saprngBO)
Dim FndList, x&
'Dim nextrow As Long
'nextrow = slip.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Dim pasteslip As Range: Set pasteslip = slip.Range("A" & nextrow)
sap.Select
sapunion.Copy
con.Select
con.Range("a:a").PasteSpecial xlPasteValues
sap.Select
sapcity2.Copy
con.Select
concity2.PasteSpecial xlPasteValues
adsrng.Copy
con.Select
conads.PasteSpecial xlPasteValues
FndList = abrv.Cells(1, 1).CurrentRegion
For x = 1 To UBound(FndList)
con.Cells.Replace What:=FndList(x, 1), Replacement:=FndList(x, 2), LookAt:=xlWhole, MatchCase:=True
Next
con.Select
con.Range("a:x").Copy slip.Range("A:X" & Rows.Count).End(xlUp).Offset(1, 0)
's2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes *this
was a different approach I was going to try if there's no way to
fix things*
'it comes from this code:
'Sub CopyUnique()
'Dim s1 As Worksheet, s2 As Worksheet
'Set s1 = Sheets("Main")
'Set s2 = Sheets("Count")
's1.Range("B:B").Copy s2.Range("a" & nextrow)
's2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
'End Sub
End Sub
`
I commented out some of the code I tried using before (I kept getting paste area is out of range). The error I'm getting now is: Run-time error '1004': Method 'Range' of object'_Worksheet' failed , when it gets to this line con.Range("a:x").Copy slip.Range("A:X" & Rows.Count).End(xlUp).Offset(1, 0)
Any ideas what I can do? I feel like I'm so close but there's something obvious staring me in the face that I can't see.
Figured it out! Adapted some code I used for another project. Wasn't able to get it to skip copies but it works!
Dim ldestlRow As Long, i As Long
Dim ins As Variant
Dim h As String, won As String
Dim wo As Range
ldestlRow = slip.Cells(Rows.Count, 1).End(xlUp).Row + 1
ins = con.UsedRange
For i = 2 To UBound(ins)
won = ins(i, 7)
Set wo = Range("W2:W" & ldestlRow).Find(what:=won)
If wo Is Nothing Then
ldestlRow = slip.Cells(Rows.Count, 1).End(xlUp).Row + 1
con.Range("A" & i).EntireRow.Copy slip.Range("A" & ldestlRow)
End If
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.