将范围复制到不同工作表

Question

我正在使用excel工作表将地址从一种格式转换为另一种格式，将其粘贴到工作表中，然后将正确格式化的地址粘贴到具有数千个地址的主表单中的下一个可用行中的记录。 可能有数百个地址需要粘贴到主表上，所以我试图避免通过特定的引用限制我的行和范围，例如像（“A2：A6790”）这样的范围不起作用，因为列表可以在转换表和主表中都变长。 在下面的示例中，我只使用一个地址，但我需要代码能够复制粘贴所有具有数据（但不是标题）的行： 我需要将突出显示的行复制到此处：

由于隐私原因，我不得不将部分地址变黑，但我突出显示了行数以显示有多少记录。

这是我的代码：

`

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

`

我评论了之前尝试过的一些代码（我不断得到粘贴区域超出范围）。我现在得到的错误是：运行时错误'1004'：对象'_Worksheet'的方法'范围'失败，当它到达此行时con.Range("a:x").Copy slip.Range("A:X" & Rows.Count).End(xlUp).Offset(1, 0)

任何想法我能做什么？我觉得自己好近，但有一些明显的东西让我看不清楚。

Answer 1

想出来！改编了我用于另一个项目的一些代码。无法得到 它可以跳过副本但是有效！

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