Sub 표변환()

    Dim i As Long
    Dim r As Long
    Dim 마지막행 As Long
    
    r = 5
    마지막행 = Range("B10000").End(xlUp).Row
    
    For i = 4 To 마지막행 Step 3
    
        Range("B" & i & ":B" & i + 2).Copy
        Range("D" & r).PasteSpecial Transpose:=True
        r = r + 1
        
    Next

End Sub