次の行の列をExcelで取得する

Question

タイトルが次の行に列のデータを置くと言うように必要です。 多くの研究の後、私はそれがマクロを使って行うことができることを学びました、そして、これはあなたの助けが必要なところです。私は何をする必要があるかの

例：私が何を意味するか

iが4列

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

のExcelドキュメントを持っている私は、すべての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に第1のDコードを "2" に行を追加するマクロを記録しcuttin-ペーストはこれです：

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スタックを使用してみましたし、私はそれが必要として、それは今の仕事をdoesntのどこまで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のすべてのデータを単純なループにすることですが、ループが実行されるときに行を追加することによってループのパラメータが複雑になります。これは、あなたがより多くを説明することができ、「それはshould_として、それは今の仕事をdoesntの_but」カウンターと一緒にチェック条件をループし、インクリメントしながら行う

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