将范围复制到不同工作表中的下一个可用单元格

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'的方法'Range'失败 ，当它到达此行时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