急ぎの案件で,いろいろ試したけど,結局マクロで強引に動かす
データが綺麗にそろっていたからできただけにすぎない
10数万行×7列で約50分の実行時間
Sub Macro3()
'
' Macro3 Macro
'
Sheets("Sheet1").Select
Dim i As Long
Dim j As Long
Dim h As Long
h = 2
i = 2
For i = 2 To 515858 Step 66
j = i + 65
Sheets("Sheet1").Select
Range("C" & i & ":C" & j).Select
ActiveCell.Offset(0, 0).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("B" & h).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Select
Range("D" & i & ":D" & j).Select
ActiveCell.Offset(0, 0).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("BP" & h).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Select
Range("E" & i & ":E" & j).Select
ActiveCell.Offset(0, 0).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("ED" & h).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Select
Range("F" & i & ":F" & j).Select
ActiveCell.Offset(0, 0).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("GR" & h).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet1").Select
Range("G" & i & ":G" & j).Select
ActiveCell.Offset(0, 0).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("JF" & h).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
h = h + 1
Next
End Sub