Копировать строки (не всю строку) с одного листа на другой - PullRequest
0 голосов
/ 16 декабря 2018

У меня проблемы с кодом ниже.«Бэкэнд» - это исходный лист, а «доступность» - целевой лист.Любая помощь приветствуется.

Sub CopyA()

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Backend").Cells(Rows.Count, "AB").End(xlUp).Row
lr2 = Sheets("Availability").Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        If Range("Backend!AB" & r).Value = "A" Then
           Range("Availability!A" & lr2 + 1 & ":C" & lr2 + 1) = 
           Range("Backend!V" & r & ":X" & r).Value2
           lr2 = Sheets("Availability").Cells(Rows.Count, "A").End(xlUp).Row
        End If
    Next r
End Sub

1 Ответ

0 голосов
/ 16 декабря 2018

Основываясь на вашем коде, я думаю, что вы пытаетесь скопировать столбцы V:X из листа Backend, если столбец AB = A и вставить данные в столбец A листа Availability.

* 1007.* Этот код достигает того, что:
Sub CopyData()
    Dim lastRow As Long, rw As Long

    lastRow = Sheets("Backend").Cells(Rows.Count, "AB").End(xlUp).Row

    With Worksheets("Backend")
        For rw = lastRow To 2 Step -1
            If .Range("AB" & rw) = "A" Then
                pasteRow = Worksheets("Availability").Cells(Rows.Count, "A").End(xlUp).Row + 1
                Range("V" & rw & ":X" & rw).Copy Destination:=Worksheets("Availability").Range("A" & pasteRow & ":C" & pasteRow)
            End If
        Next rw
    End With
End Sub

В вашем исходном коде вы возвращаетесь назад с Step -1.Следствием этого является то, что данные, вставленные в Availability, будут в обратном порядке.Если вы хотите, чтобы вставленные данные отображались в том порядке, в котором они находятся в backend, используйте вместо этого следующий код:

Sub CopyData2()
    Dim copyRng As Range, cl As Range

    Set copyRng = Worksheets("Backend").Range("AB2:AB" & Worksheets("Backend").Cells(Rows.Count, "AB").End(xlUp).Row)

    With Worksheets("Availability")
        For Each cl In copyRng
            If cl = "A" Then
                pasteRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                Worksheets("Backend").Range("V" & cl.Row & ":X" & cl.Row).Copy Destination:=.Range("A" & pasteRow & ":C" & pasteRow)
            End If
        Next cl
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...