使用宏在Excel上的下一行获取列

Question

我需要标题说将列中的数据放到下一行。 经过大量的研究，我了解到可以使用宏来完成，这是我需要你帮助的地方。

我需要做的例子：

我的意思是我有一个包含4列的Excel文档

   A      B       C        D
1  Data1   Data2  Data3   Data4
2  Data5   Data6  Data7   Data8

我希望每个D列数据都像这样进入下一行。

   A      B       C       
1  Data1   Data2  Data3   
2  Data4   // First Data of D column on below line moved on line 2
3  Data5   Data6  Data7 
4  Data8  // Second Data of D column on below line moved on line 4.

所以我录制了一个在“2”上添加一行的宏，并在新的2上剪切粘贴第一个D.代码是这样的：

Sub Data1()
'
' Data1 Macro
'
' 
'
    ActiveCell.Offset(1, 0).Range("A1:D1").Select
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 3).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -3).Range("A1").Select
    ActiveSheet.Paste
End Sub

结果：

问题在于，需要运行很多次数据，所以这里真的需要一个循环。

尝试使用循环但是iam堆栈在这里，我需要你的帮助

多大程度上是iam但它现在不能正常工作。

Dim x As Integer

Sub Data1()
'
' Data1 Macro
'
' 
'
    x = 1


    Do While x <= 20 ' that i will change as how many columns i have.
        ActiveCell.Offset(x, 0).Range("A1:D1").Select
        Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(x - 2, x + 2).Range("A1").Select
        Selection.Cut
        ActiveCell.Offset(x, x - 4).Range("A1").Select
        ActiveSheet.Paste

        x = x + 2 ' if it starts from cell no1 and we have a blank to fill with Data4 or Data8 of D row then we need x+2 i believe and not x+1.
    Loop
End Sub

包含大量数据和第二次修改（不工作）代码的结果：

提前感谢。

Answer 1

执行此操作的最佳方法是简单地循环遍历D中的所有数据，尽管循环的参数因循环运行时添加行而变得复杂。这可以通过使用do while循环并将检查条件与计数器

一起递增来解决

Sub ConvertColDtoRow()
'Note that this code is written specifically for column D, but it can be adjusted as needed by changing the column specified

Dim Count As Long, LastRow As Long
Count = 1
LastRow = ActiveSheet.UsedRange.Rows.Count
Do While Count <= LastRow
    If Not IsEmpty(ActiveSheet.Cells(Count,4)) Then
        Range(Cells(Count,4).Address).Offset(1,0).EntireRow.Insert
        Cells(Count + 1,1).Value = Cells(Count,4).Value
        Cells(Count,4).Value = ""
        Count = Count + 2
        LastRow = LastRow + 1
    Else
        Count = Count + 1
    End If
Loop

End Sub