マクロで範囲を可変でループするには？

質問

エクセルマクロで次のようなことをしたいのですが、どなたか教えてください。

A列の空白行までを1グループにして行列を入れ替えCからコピー
をA列のデータがなくなるまで繰り返す。
よろしくお願いします。
例：
セルA　：　B ：　C ：　D　：　E ：　
　１あ　　　　　　あ　　い　　う
　２い　　　　　　え　　お
　３う　　　　　　 か　 き
　４
　５え
　６お
　７
　８か
　９き

回答No.2

tom04 · ベストアンサー

こんにちは！

一例です。

Sub Sample1()
Dim i As Long, j As Long, k As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) <> "" Then
k = i
Do While Cells(k, 1) <> ""
k = k + 1
Loop
Range(Cells(i, 1), Cells(k, 1)).Copy
Cells(Rows.Count, 3).End(xlUp).Offset(1).PasteSpecial Paste:=xlValues, Transpose:=True
i = k
End If
Next i
j = ActiveSheet.UsedRange.Columns.Count
Range(Cells(1, 3), Cells(1, j)).Delete shift:=xlUp
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

有難う御座います。出来ました。

回答No.3

mu2011

一例です。

Sub sample()
Dim rng, r, i As Long
With Application
.ScreenUpdating = False
If .CountA(Columns(1)) = 0 Then End
Range(Columns(3), Columns(Columns.Count)).ClearContents
Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp)). _
SpecialCells(xlCellTypeConstants).Areas
For Each r In rng
i = i + 1
Cells(i, 3).Resize(, r.Count) = .Transpose(r)
Next
.ScreenUpdating = True
End With
End Sub

お礼

有難う御座います。こちらでもできました！。

回答No.1

kybo

こんな感じかなと思います。

Sub macro()
Dim C As Range, D As Range, I As Integer
Set C = Range("A1")
Do
Set D = C.End(xlDown)
I = I + 1
Range(C, D).Copy
Range("C" & I).PasteSpecial Transpose:=True
Set C = D.End(xlDown)
Loop Until C.Address = Range("A" & Rows.Count).Address
End Sub

補足

有難う御座います。
A列に一行のみがあったばあい、うまくいかないような？