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")