Скопировать диапазон в следующую доступную ячейку на другом листе - PullRequest
0 голосов
/ 27 апреля 2018

Я работаю с листом Excel, который преобразует адреса из одного формата в другой, вставляет его в лист, а затем должен вставить правильно отформатированные адреса в следующую доступную строку в мастер-листе с тысячами адресов. записей. Могут быть сотни адресов, которые нужно вставить в мастер-лист, поэтому я стараюсь не ограничивать мои строки и диапазоны конкретными ссылками, например, такой диапазон, как («A2: A6790»), не будет работать, потому что списки могут получить длинный как в конверсионном листе и мастер-листе В приведенном ниже примере я использую только один адрес, но мне нужен код, чтобы можно было скопировать и вставить все строки, в которых есть данные (но не заголовок): Copy1 Мне нужна выделенная строка, чтобы скопировать сюда: copy2

Мне пришлось отключить некоторые адреса из соображений конфиденциальности, но я выделил количество строк, чтобы показать, сколько существует записей.

Вот мой код:

`

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': метод 'Range' объекта'_Worksheet 'не удалось , когда он попадает в эту строку con.Range("a:x").Copy slip.Range("A:X" & Rows.Count).End(xlUp).Offset(1, 0)

Есть идеи, что я могу сделать? Я чувствую, что я так близко, но что-то очевидное смотрит мне в лицо, которое я не вижу.

1 Ответ

0 голосов
/ 30 апреля 2018

Разобрался! Адаптированный код, который я использовал для другого проекта. Не смог получить это, чтобы пропустить копии, но это работает!

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 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...