VBA宏根據單元格值復制並粘貼到特定位置

Question

@ShaiRado幫助我重新處理了一個宏，以使我可以將主表“ Tracker”中的信息復制並粘貼到正在構建“ Sheet1”的儀表板中，如果列J的狀態為“完成”，“進行中”或“即將進行” ”。

效果很好-但是我真正想要的是根據J列的狀態將信息粘貼到離散的單獨位置。例如，我的意思是； 我希望所有“完成的”行都放在一起，例如A1：A50，所有即將到來的行都坐在A60：A100，所有“進行中”的行都坐在A101：A150，甚至跨越AK，MS ，U-AC之類的東西？

這是我到目前為止的內容：

Option Explicit

Sub Copybasedonstatus()

'Niall McCracken 12/12/16

Dim lRow As Long, cRow As Long, j As Long

 With Sheets("Tracker")
    lRow = .Range("A800").End(xlUp).Row

    ' another method of finding last row in Column A (skipping blank cells in the middle)
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For j = lRow To 1 Step -1
        cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row

        Select Case .Range("J" & j).Value
            Case "Upcoming"
                .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

            Case "Complete"
                .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

            Case "In Progress"
                .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)

        End Select
    Next
End With

End Sub

Answer 1

我們可以更改案例以在您建議的列中找到下一個可用行：

Case "Upcoming"
    .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Cells(Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row + 1, "A")

Case "Complete"
    .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Cells(Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "M").End(xlUp).Row + 1, "M")

Case "In Progress"
    .Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Cells(Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "U").End(xlUp).Row + 1, "U")