Question

我需要Excel中的宏帮助。我在Excel中有一个表（附例）。

我需要源表中的A，E和G列，在最后一行之后我需要A，E和H，在最后一行A，E和I之后等等。意味着A列和E列将保持不变，只有第三列才会更改，直到列K. 以垂直方式。

来源数据：

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

目标：

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

编辑：我正在尝试的代码：

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

查找最后一行：Excel VBA select range at last row and column

在源表上找到最后一行数据并存储为变量。
保存范围从A1：Alastrow和E1：Elastrow并存储为变量（因为我们需要它三次）
Union（AE范围和G1：Glastrow）
复制/粘贴
Union（AE范围和H1：Hlastrow）
复制
查找目的地最后一行
粘贴目标最后一行+ 1
重复所有I，J和K

您可以从提供的帮助文件中编写自己的代码

编辑：代码修复：

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

用于从多个列中进行选择的宏

1 个答案: