用VBA將壹列數據轉置成多行多列？

代碼在下邊，自己復制吧。

Sub 自定義轉置()

If MsgBox("確定執行轉置程序嗎？", vbYesNo, "請確認") = vbNo Then Exit Sub

Dim x1$, x2%, y1$, y2%, iShu%, i&

'參數1，起始列號x1

Application.Speech.Speak "請輸入原始列號字母，大小寫均可"

x1 = InputBox("請輸入原始列號字母，大小寫均可。", "原始列號")

If x1 = "" Then MsgBox "妳點擊了取消，程序已中止！", , "提示": Exit Sub

'參數2，起始行號x2

Application.Speech.Speak "請輸入原始杭號數字"

x2 = Val(InputBox("請輸入原始行號數字", "原始行號"))

If x2 < 1 Then MsgBox "行號不能小於1，程序已中止！", , "提示": Exit Sub

'參數3，放置列號y1

Application.Speech.Speak "請輸入放置列號字母，大小寫均可"

y1 = InputBox("請輸入放置列號字母，大小寫均可。", "放置列號")

If y1 = "" Then MsgBox "妳點擊了取消，程序已中止！", , "提示": Exit Sub

'參數4，放置行號y2

Application.Speech.Speak "請輸入放置杭號數字"

y2 = Val(InputBox("請輸入放置行號數字", "放置行號"))

If y2 < 1 Then MsgBox "行號不能小於1，程序已中止！", , "提示": Exit Sub

'參數5，轉置列數ishu

Application.Speech.Speak "妳想轉置成幾列呢"

iShu = Val(InputBox("請輸入轉置後的列數", "轉置列數"))

If iShu < 1 Then MsgBox "列數不能小於1，程序已中止！", , "提示": Exit Sub

'確認參數，如果發現錯誤，給予取消執行的機會

Application.Speech.Speak "請確認妳的參數，如有錯誤可以取消"

If MsgBox("請確認妳的參數：" & vbLf & vbLf & "源數據：起始列號：" & x1 & "，起始行號：" & x2 _

& vbLf & vbLf & "新數據：放置列號：" & y1 & "，放置行號：" & y2 _

& vbLf & vbLf & "轉置後：放置列數：" & iShu, vbOKCancel, "確認參數") = vbCancel Then Exit Sub

'轉置處理

For i = x2 To Range(x1 & Rows.Count).End(3).Row Step iShu

Range(x1 & i).Resize(iShu, 1).Copy

Range(y1 & y2).PasteSpecial Paste:=xlPasteAll, Transpose:=True

y2 = y2 + 1

Next

'完成後進行提醒

Application.Speech.Speak "處理完畢"

MsgBox "處理完畢！", , "提示"

End Sub