Sub 표변환()

    Dim i As Long
    Dim r As Long
    
    r = 5
    
    For i = 4 To 100 Step 3
    
        If Range("B" & i).Value = Empty Then Exit For

        Range("B" & i & ":B" & i + 2).Copy
        Range("D" & r).PasteSpecial Transpose:=True
        r = r + 1
        
    Next

End Sub
