Excelのマクロについて質問です。

Sub 並べ替え()

　Dim sheet1 As Variant

　Dim sheet2 As Variant

　Dim x As Integer

　Dim y As Integer

　Dim xx As Integer

　sheet1 = ActiveSheet.Name

　Worksheets.Add

　sheet2 = ActiveSheet.Name

　Do Until y = 24

　　Do Until x = 365

　　　Worksheets(sheet2).Range("a1").Offset(xx, 0).Value = Worksheets(sheet1).Range("a1").Offset(y, x).Value

　　　x = x + 1

　　　xx = xx + 1

　　Loop

　　x = 0

　　y = y + 1

　Loop

End Sub

もとデータのシートがアクティブな状態で実行すれば、

これでできると思います。

ちなみに、ものすごくおせっかいだったら申し訳ないのですが、

行が365で列が24でいいんですよね？？逆ではないですよね？

私のエクセルは古いため、行が256までしかないので、

心配になってしまいました…。

もし万が一逆のようでしたら、

　Do Until y = 24

　　Do Until x = 365

を

　Do Until y = 365

　　Do Until x = 24

に変更していただければ大丈夫です。

余計なお世話だったらすいません…。

お仕事が無事に終わることをお祈り申し上げます。

列が256を越えることはないですね。

列と行を入れ替えました。

多分２４時間365日だと思いますので、１列目に0～2３の数値をふり、

24時間ごとに線を引いてみました。

もしこちらを先に開いたら、先の回答は開封不要です。

Const numOfRow = 365   ' --- データの列数
Const numOfCol = 24  ' --- データの行数

'------------------------------------------------------
'   1枚目に新しく集計用シートを作成し、
'   2枚目以降の numOfRow（行数） × numOfCol（列数）
'   のデータを先頭シートに1列にコピーします。
'------------------------------------------------------
Sub reOrder()
'------------------------------------------------------
    Dim dstWs As Worksheet
    Dim srcWs As Worksheet
'--- 先頭に集計用のシートを追加
    Set dstWs = Worksheets.Add(before:=Worksheets(1))
    
    Dim c As Long
    Dim r As Long
    dstWs.Range("A1").Resize(365 * 24, Worksheets.Count).Borders.Weight = xlHairline
    For r = 1 To 24 * 365
        Cells(r, "A").Value = (r - 1) Mod 24
        If r Mod 24 = 1 Then
            With Range("A" & r).Resize(24, Worksheets.Count)
            .Borders(xlEdgeTop).Weight = xlThin
            .Borders(xlEdgeBottom).Weight = xlThin
            End With
        End If
    Next
    
    For Each srcWs In Worksheets
        Application.ScreenUpdating = False
        If srcWs.Index >= 2 Then
            For r = 1 To numOfRow
                For c = 1 To numOfCol
                    dstWs.Cells((r - 1) * numOfCol + c, srcWs.Index).Value _
                        = srcWs.Cells(r, c).Value
                Next
            Next
        End If
        Application.ScreenUpdating = True
        DoEvents
    Next
End Sub