Выполнять до пустой строки цикла в макросе

Question

У меня есть файл данных с одним столбцом и несколькими строками (динамический список). Я хочу перенести первые 28 строк в первую строку, вторую 28 строк во вторую строку и так далее. Я хочу, чтобы это выполнялось до тех пор, пока не будет найдена пустая строка. Однако, когда я запускаю код, он переносит только первые 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