在macros上获得下一行的列

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

我需要做的例子：

我的意思是说，我有一个4列的Excel文档

ABCD 1 Data1 Data2 Data3 Data4 2 Data5 Data6 Data7 Data8 

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

  ABC 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. 

所以我logging了在“2”上添加一行的macros，并在新的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堆栈在这里，那里是我需要你的帮助

这是多远远，但它现在不工作，因为它应该。

 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中的所有数据进行一个简单的循环，尽pipe通过在循环运行时添加行来增加循环的参数。 这是通过使用一个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