Sub 표변환()

    Dim i As Long
    Dim 마지막행 As Long
    Dim 복사위치 As Range
    
    마지막행 = Cells(Rows.Count, "B").End(xlUp).Row
    
    Range("D4").CurrentRegion.Offset(1).Clear
    
    Set 복사위치 = Cells(Rows.Count, "D").End(xlUp)
    
    For i = 4 To 마지막행 Step 3
    
        Set 복사위치 = 복사위치.Offset(1)
    
        Range("B" & i).Resize(3, 1).Copy
        복사위치.PasteSpecial Transpose:=True
        
    Next

End Sub