「VBA」カテゴリーアーカイブ

Excelのマクロで云々

急ぎの案件で,いろいろ試したけど,結局マクロで強引に動かす

データが綺麗にそろっていたからできただけにすぎない

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