变量列为1列 - 覆盖问题

Question

我正处于此脚本的最后一段并且输出有问题。我有一个变量＃列，我试图将列转置/粘贴到没有标题行的表格下面的一列中。

Title   Title
1       3  ===== > =======  1
2       4  ===== > =======  2
                            3
                            4

我的陈述

For iCol = 1 To rng.Columns.Count

    Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
    ActiveSheet.Paste Destination:=Cells(lastCell, 3)
    lastCell = lastCell + rng.Columns(iCol).Rows.Count

Next iCol

我遇到的问题是粘贴会覆盖自己。

完整陈述供参考：

Dim rng As Range
Dim iCol As Integer
Dim lastCell As Integer
Dim secondlCol As Long
'///////////////////////////////////////////////////////
secondlRow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row

    'Find the last non-blank cell in row 1
    secondlCol = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column

    theActiveCell = "B4:" & Col_Letter(secondlCol) & "5"
    theActiveCell = theActiveCell
    theActiveCellSel = ActiveSheet.Range(theActiveCell).Select
'///////////////////////////////////////////////////////
Set rng = Range(theActiveCell).CurrentRegion
lastCell = ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column

For iCol = 1 To rng.Columns.Count

    Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
    ActiveSheet.Paste Destination:=Cells(lastCell, 3)
    lastCell = lastCell + rng.Columns(iCol).Rows.Count

Next iCol

注意：插图显示右侧的输出，但它将显示在表格下方。很难在编辑器中形成它。