返回宏末尾的第一个单元格

我不知道的简单问题。我在下面做了一个基本的宏，但是我无法让它返回到起点+右边的一列。

• 从B2开始复制一列。


• 将该数据添加到第1列的数据底部。


• 返回到起始单元格，然后再移动一个。

看图片，绿色是我的起点，然后将列复制到橙色，然后要移至绿色右侧的红色单元格

Sub MOVE_COLUMN_TO_ROW1()
Range(Selection,Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
activeCell.Offset(1,0).Range("A1").Select
activeSheet.Paste
Selection.End(xlUp).Select
activeCell.Offset(0,2).Range("A1").Select
End Sub


一些提示可用于以下假设：

_{样本数据：}

_代码：

Sub Test()
Dim lr As Long 'Use a variable to capture the last used row
Dim lc As Long 'Use a variable to capture the last used column
Dim x As Long 'Use a variable to loop through all used columns
Dim arr As Variant 'Use a variable to capture values you want to transfer
With Sheet1 'Be,at least,explicit about a worksheet object using its CodeName
'Getting the last used column from the 1st row using xlToLeft
lc = .Cells(1,.Columns.Count).End(xlToLeft).Column
'Loop from 2nd column to the last used column
For x = 2 To lc
'Catch the last used row in the current column(x)
lr = .Cells(.Rows.Count,x).End(xlUp).Row
'Fill the array to use in your data transfer
arr = .Range(.Cells(2,x),.Cells(lr,x))
'Catch the last used row in the first column
lr = .Cells(.Rows.Count,1).End(xlUp).Row
'Transpose the found range underneath last used row of column 1
.Cells(lr + 1,1).Resize(UBound(arr),1).Value = arr
'Continue with the next column
Next x
End With
End Sub


_结果：

请注意，代码相当广泛，可以编写得更紧凑，但是我的目标是/我希望您能够以此方式理解过程的每个步骤。

祝你好运，编码愉快=）