マクロを短くする

Sub Macro4()
'
' Macro4 Macro
'

'
Range("D2:G2").Select
Selection.Copy
Range("AF2").Select
ActiveSheet.Paste
Range("I2:I5").Select
Application.CutCopyMode = False
Selection.Copy
Range("AL2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("J2:J5").Select
Application.CutCopyMode = False
Selection.Copy
Range("AQ2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("P2:P5").Select
Application.CutCopyMode = False
Selection.Copy
Range("AV2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("K2:K5").Select
Application.CutCopyMode = False
Selection.Copy
Range("BA2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("O2:O5").Select
Application.CutCopyMode = False
Selection.Copy
Range("BF2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("Q2:Q5").Select
Application.CutCopyMode = False
Selection.Copy
Range("BK2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("L2:L5").Select
Application.CutCopyMode = False
Selection.Copy
Range("BP2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("N2:N5").Select
Application.CutCopyMode = False
Selection.Copy
Range("BU2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("R2:R5").Select
Application.CutCopyMode = False
Selection.Copy
Range("BZ2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("S2:S5").Select
Application.CutCopyMode = False
Selection.Copy
Range("CE2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("T2:AC2").Select
Application.CutCopyMode = False
Selection.Copy
Range("CJ2").Select
ActiveSheet.Paste
End Sub
このマクロをもっと短いマクロにひたいのですが、そのマクロを教えて下さい。宜しくお願い致します。
後、３８５行まであります。
できれば１行ずつのマクロの意味も書いて頂けると幸いです。

No.1 ベストアンサー 回答者： fujillin 回答日時： 2023/01/15 02:43

こんばんは

＞できれば１行ずつのマクロの意味も書いて頂けると幸いです
処理の結果はご存じでしょうけれど、全体的にコピペを繰り返しているだけです。
恐らく、マクロの記録で作成したそのままなのでしょう。

ご提示のマクロでは、大体、4～5行のコードが1回のコピペに相当していますが、コピペの際に行列を入れ替えている場合と、そうでない場合があるようです。
このあたりを整理して、繰り返しできるものは繰り返しの処理にすれば、短くすることは可能でしょう。

以下、ご参考までに。
（質問文に記載のある処理内容のみです）

Sub Q_13311697()
Dim colNo, c, d
colNo = Array(9, 10, 16, 11, 15, 17, 12, 14, 18, 19)

Range("D2:G2").Copy Range("AF2")
Range("T2:AC2").Copy Range("CJ2")

Set d = Range("AL2")
For c = LBound(colNo) To UBound(colNo)
Cells(2, colNo(c)).Resize(4).Copy
d.PasteSpecial Transpose:=True
Set d = d.Offset(, 5)
Next c
Application.CutCopyMode = False
End Sub

この回答へのお礼

有難うございました。頑張ります。

お礼日時：2023/01/15 10:44