VBA宏根据单元格值复制并粘贴到特定位置

Question

@ShaiRado helped me rework a macro to allow me to copy and paste info from my main sheet "Tracker" to a dashboard I'm building "Sheet1" if the status of column J is either "complete" "In progress" or "Upcoming".

It works great - but what I would really like is the information to be pasted to discrete separate locations based on the status of column J. As an example, what I mean by that is; I would like all of the "complete" rows to sit together eg A1:A50, all of the upcomings to sit in A60:A100 and all of the "in progress" to sit in A101:A150, or even going across AK, MS, U-AC something like that?

Here is what I have so far:

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

We can change the cases to find the next available row in the columns you suggest:

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