复制缺少步骤的列

Question

问题在于，直到某一点，每列都复制到右侧，然后突然开始向左移动，而忽略了列。

我还没有写东西，到目前为止还无法将其拆开甚至尝试正确解决。我已经弄弄了，但是还没有得到任何有用的结果。

For colx = 2 To maxColumns Step 2
ActiveSheet.Columns(colx).Insert
ActiveSheet.Columns(colx - 1).Interior.Color = RGB(255, 153, 0)
Next

maxRows = ActiveSheet.UsedRange.Rows.Count
maxColumns = ActiveSheet.UsedRange.Columns.Count * 2 + 1

For colx = 2 To maxColumns Step 2
For iRow = 1 To maxRows
WorksheetFunction.CountA (Columns(1))
'If there is a comment, paste the comment text into column D and delete the original comment.
ActiveSheet.Cells(iRow, colx).Value = Trim(ActiveSheet.Cells(iRow, colx - 1).Value)
Next iRow
Next

如下图所示，尽管“ AL”列中也出现了“ Deposit Amount”，但“ Rent Frequency”却出现了“ Rental Amount”和“ Deposit Amount”。同样，AT列应具有“属性类型”，AV列应具有“家具类型”，依此类推，依此类推...

Answer 1

为此替换整个代码：

Option Explicit


Sub Macro1()
Dim LCol As Long, LRow As Long, i as Long, j as Long
With ThisWorkbook.Worksheets("Sheet1")
    LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1", .Cells(LRow, LCol)).Interior.Color = RGB(255, 153, 0)
    For i = 1 To (LCol*2 - 1) Step 2
        .Columns(i+1).Insert
        For j = 1 To LastRow
            .Cells(j, i+1).Value = Trim(.Cells(j, i).Value)
        Next j
    Next i
End With
End Sub