データ変換。

外乱に影響されながらも
午前中かかってやっとマクロを組みました。
久しぶりだったので大苦戦。
スキル落ちてるわ

へたれで恥ずかしいけど公開しちゃうわ（＾＾
ただ単に１列のデータを８列にして番号振るだけです（ｗ

Sub data_exch()

Dim i, j, k, l, m, n As Integer
i = 3: j = 1
'コピー元行（１、２、３、４、５，６，７、、、、EOL）
'コピー元列（１固定）
k = 2: l = 2
'ペースト先行（１、２、３、４、５，６，７、、、、EOL）
'ペースト先列（２固定）
m = 0
'データ行カウント
n = 0

Do
n = n + 1

Cells(i - 1, j).Select
Selection.NumberFormatLocal = "0.000_ "

Cells(i, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

Cells(i + 1, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l + 1).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

Cells(i + 2, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l + 2).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

Cells(i + 3, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l + 3).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

Cells(i + 4, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l + 4).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

Cells(i + 5, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l + 5).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

Cells(i + 6, j).Select
Application.CutCopyMode = False
Selection.Copy
Cells(k, l + 6).Select
ActiveSheet.Paste
Selection.NumberFormatLocal = "0.000_ "

m = m + 1
Cells(k, l + 7) = m

Range(Cells(i, j), Cells(i + 6, j)).Select
Selection.Delete Shift:=xlUp

i = i + 1
k = k + 1

Loop Until n = 750
End Sub