急ぎの案件で,いろいろ試したけど,結局マクロで強引に動かす
データが綺麗にそろっていたからできただけにすぎない
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