Получение столбца на следующей строке на Excel с макросом

Question

Мне нужно, как говорится в заголовке, чтобы поместить данные из столбца в следующую строку. После многих исследований я узнал, что это можно сделать с помощью макросов, и именно здесь мне нужна ваша помощь.

Пример того, что мне нужно сделать:

Что я имею в виду, что у меня есть документ первенствовать с 4-мя колоннами

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» и разрезал вставить первый D на новом 2. Кодекс заключается в следующем:

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 стека здесь и там, где я нужна ваша помощь

Thats насколько 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 

Результат с большим количеством данных и 2-модифицированных (не работает) Код:

спасибо заранее.

Answer 1

Лучший способ сделать это будет простой цикл по всем данным в D, хотя параметры цикла сложны добавлением строк по мере запуска цикла. Это решается с помощью делать во время цикла и приращение условия проверки вместе со счетчиком

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