マクロ内で空の行ループが発生するまで実行します。

Question

1つの列と複数の行（動的リスト）を持つデータファイルがあります。最初の28行を最初の行に、2行目を28行目を2行目に転置したいと思います。私はこれが空の行が見つかるまで実行します。しかし、コードを実行すると、最初の28行のみが転置されます。私は "do until empty"ループで結果を得ることができず、エラーを発見できませんでした。 ご協力いただきありがとうございます。

Sub Macro1() 
    ' 
    ' Macro1 Macro 
    ' 
    ' 
    Range("A1").Select 
    Do 
    Range("A1:A28").Select 
    Selection.Copy 
    Sheets("Sheet2").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,  SkipBlanks:= _ 
    False, Transpose:=True 
    ActiveCell.Offset(1, 0).Select 
    Loop Until ActiveCell.Value = "" 
    End Sub 

Answer 1

マクロレコーダーはループを行いません。あなたはループからOffsetを引き出す必要があります。それ以外の場合は、完全にそれを修飾：

UPDATE

Option Explicit 

Sub CopyPaste() 

Dim CopySheet As Worksheet 
Dim PasteSheet As Worksheet 
Dim MyRange As Range 
Dim i As Long 
Dim r As Long 
Dim wf As WorksheetFunction 

Application.ScreenUpdating = False 

Set wf = Application.WorksheetFunction 
Set CopySheet = ActiveWorkbook.Worksheets("Sheet1") 
Set PasteSheet = ActiveWorkbook.Worksheets("Sheet2") 
Set MyRange = CopySheet.Range("A1:A28") 
r = MyRange.Rows.Count 
i = 1 

Do Until wf.CountA(MyRange) = 0 
    MyRange.Copy 
    PasteSheet.Cells(i, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True 
    Set MyRange = MyRange.Offset(r, 0) 
    i = i + 1 
Loop 

Application.ScreenUpdating = True 

End Sub