VBA セル範囲コピー 図形のみ

質問

現在下記コードで指定のセル範囲のコピーをしています。

B4セルからI33セル範囲内にはjpg画像ファイルと
そのjpgファイルに印をする為、図形の円があります。
円は複数ありjpgファイルに重なっています。

今回行いたのは、B4セルからI33セルをコピーして
J4、R4セルに貼り付ける際に
jpgファイルは貼り付けないで、図形の円のみを貼り付けしたいです。

宜しくお願いします。

Sub セルコピー()

Range("B4:I33").Select
Range("I33").Activate
Selection.Copy
Range("J4").Select
ActiveSheet.Paste
Range("R4").Select
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub

回答No.1

SI299792 · ベストアンサー

jpg ファイルは貼り付けないで、図形の円のみを貼り付け
不可能ではないと思いますが、難しすぎます。
全てコピーした後、画像を消したほうが手っ取り早いです。
'
Sub AutoShapeCopy()
'　 コピペの後画像を削除
　　Dim OldCount As Integer
　　Dim Count As Integer
'
　　OldCount = ActiveSheet.Shapes.Count + 1
　　[B4:I33].Copy [J4]
　　[B4:I33].Copy [R4]
'
　　For Count = ActiveSheet.Shapes.Count To OldCount Step -1
'
　　　　If ActiveSheet.Shapes(Count).Type = msoPicture Then
　　　　　　ActiveSheet.Shapes(Count).Delete
　　　　End If
　　Next Count
End Sub

なお、コピーも変えました。マクロの記録を使うと、あのように長くなりますが、この書き方なら１行で済むし、一目でわかります。

お礼

返信が遅くなってしまいすみません。

本日会社の方で頂いたコードを試すことができました。

理想通りの事ができました。
大変ありがとうございました。