excel列转行vba代码

Sub 排期计划多行展示()
On Error Resume Next '如遇错误继续运行
'Set selectedRange = ActiveWindow.RangeSelection
'MsgBox "选中的区域地址：" & selectedRange.Address & selectRange
Set selectedRange = Application.InputBox("请选择一个范围", Type:=8) ' Type:=8 表示范围选择
Dim selectedSheet As Worksheet
If Not selectedRange Is Nothing Then
  'MsgBox "选中的区域地址：" & selectedRange.Address
  If selectedRange.Areas.Count > 1 Then
    MsgBox "请选择单个区域"
    Exit Sub
  End If
  
Else
    MsgBox "没有选择任何范围"
    Exit Sub
End If
Dim firstCellRow As Integer
Dim firstCellCol As Integer
Dim lastCellRow As Integer
Dim lastCellCol As Integer

For Each c In selectedRange.Areas
       firstCellRow = c(1).Row
       firstCellCol = c(1).Column
       lastCellRow = c(c.Count).Row
       lastCellCol = c(c.Count).Column
       Set selectedSheet = c.Worksheet
Next
'MsgBox "第一个单元格row=" & firstCellRow & "col=" & firstCellCol & "最后一个单元格row=" & lastCellRow & "col=" & lastCellCol

Dim k As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用警告提示
Worksheets("汇总").Delete '删除原汇总表
Set ws = Worksheets.Add(before:=Sheets(1)) '新建工作表
ws.Name = "汇总" '新建工作表命名为汇总
ws.Range("D:E").NumberFormat = "yyyy/mm/dd"
ws.Range("D:E").ColumnWidth = 15

ws.Cells(1, 1) = "区域"
ws.Cells(1, 2) = "分组"
ws.Cells(1, 3) = "话题"
ws.Cells(1, 4) = "日期"
'ws.Cells(1, 5) = "结束时间"
ws.Range("A1:E1").HorizontalAlignment = xlCenter
ws.Range("A1:E1").Font.Size = 15
ws.Range("A1:E1").Font.Blod = True
k = 2
For j = firstCellCol To lastCellCol Step 2  '列号
 For i = firstCellRow To lastCellRow  '行号
  ws.Cells(k, 1) = Right(selectedSheet.Cells(i, 1), 1) '区域
  ws.Cells(k, 2) = selectedSheet.Cells(i, j)  '小组
  ws.Cells(k, 3) = selectedSheet.Cells(i, j + 1) '话题
  ws.Cells(k, 4) = selectedSheet.Cells(17, j)  '开始时间
  'ws.Cells(k, 5) = selectedSheet.Cells(17, j + 1) '结束时间
  k = k + 1
 Next i
Next j
Application.DisplayAlerts = True '恢复警告提示
Application.ScreenUpdating = True '开启屏幕刷新
'MsgBox "列合并完毕"
End Sub