用于从多列中选择的宏

Question

I need help on macros in Excel. I have a table in Excel (example attached).

I need columns A, E and G from source sheet, after last row i need A,E and H , after last row A,E and I and so on. Means Column A and E will be constant, only third column will change until column K. In vertical manner.

Source data:

A      B     C      D       E       F     G     H        I     J      K
NAME  AGE    CITY  STATE  COUNTRY  CODE  PART  DUEDATE  VEND   COMM   QTY

Target:

A E G
A E H
A E I
A E J
A E K

EDIT: Code I am trying:

Sub Mosaic()

With ws
'Get the last row and last column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

With ws2
    'Get the last row and last column
    lRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
    lCol2 = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

'Save the range from A1:Alastrow and E1:Elastrow and store as variable
Set aRng = ws.Range("A1" & lRow)
Set aRng2 = ws.Range("E1" & lRow)
'Union(AE range and G1:Glastrow)

Set gRng = ws.Range("G1" & lRow)
Set hRng = ws.Range("H1" & lRow)

Set uRng = Union(aRng, aRng2, gRng)
uRng.Copy
ws2.Range("A" & lRow2).PasteSpecial

End Sub

Answer 1

Finding last rows: Excel VBA select range at last row and column

1. Find the last row of data on source sheet and store as variable.
2. Save the range from A1:Alastrow and E1:Elastrow and store as variable (since we need it three times)
3. Union(AE range and G1:Glastrow)
4. Copy / Paste
5. Union(AE range and H1:Hlastrow)
6. Copy
7. Find destination last row
8. Paste destination last row + 1
9. Repeat for all I, J, and K

You can write your own code from the help file provided

Edit: The fix for your code:

Sub Mosaic()
    Dim aRng, eRng, extraRng as Range
    Dim lRow, lRow2, CurCol as Long

        With ws
        'Get the last row and last column
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        End With

        'Save the range from A1:Alastrow and E1:Elastrow and store as variable
        Set aRng = ws.Range("A1:A" & lRow)
        Set aRng2 = ws.Range("E1:E" & lRow)
    For CurCol = 7 to 11 'Cols G (7) to K (11)
        Set extraRng = ws.Range(Cells(2, CurCol),Cells(lRow, CurCol))
        'Always get the lRow2 right before pasting to ensure you have the last row.
            'Get the last row of destination sheet
            lRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1
        aRng.Copy
        ws2.Range("A" & lRow2).PasteSpecial
        eRng.Copy
        ws2.Range("B" & lRow2).PasteSpecial
        extraRng.Copy
        ws2.Range("C" & lRow2).PasteSpecial
    Next CurCol
End Sub