【VBA】3個の図形をコピーしてSheet2に貼り付けたい

お世話になります。

マクロで3個の横書きテキストボックス(図形)をコピーして
Sheet2に貼り付けたいと思っております。

とりあえず1個だけの時のコードは自力で作成できました。
※Test1です

3個になった場合でもTest1の動作を3回繰り返して
Test2のようにすれば出来ますが、、、。

コードを見て頂ければわかりますがSheet1とSheet2を2回も往復するのは
能率が悪く、もっと良い方法があるように思います。

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
もっとシンプルで能率の良い方法があれば教えて下さい。よろしくお願いします

---------------------------------
Sub Test1()
'シート2の表示と1個の図形のコピペ()

ActiveSheet.Shapes.Range("テスト1").Select
Selection.Copy

'Sheet2をアクティブ
Sheets("Sheet2").Select

'Sheet2の図形を削除
図形 = Shape
For Each 図形 In ActiveSheet.Shapes
図形.Delete
Next 図形

'Sheet2に貼り付け
Range("B10").Select
ActiveSheet.Paste

'図形の選択解除
Range("A1").Select

End Sub
---------------------------------
Sub Test2()
'シート2の表示と3個の図形のコピペ()

ActiveSheet.Shapes.Range("テスト1").Select
Selection.Copy

'Sheet2をアクティブ
Sheets("Sheet2").Select

'Sheet2の図形を削除
図形 = Shape
For Each 図形 In ActiveSheet.Shapes
図形.Delete
Next 図形

'Sheet2に貼り付け
Range("B10").Select
ActiveSheet.Paste


'----------
'Sheet1をアクティブ
Sheets("Sheet1").Select

ActiveSheet.Shapes.Range("テスト2").Select
Selection.Copy

'Sheet2をアクティブ
Sheets("Sheet2").Select

'Sheet2に貼り付け
Range("B15").Select
ActiveSheet.Paste

'----------
'Sheet1をアクティブ
Sheets("Sheet1").Select

ActiveSheet.Shapes.Range("テスト3").Select
Selection.Copy

'Sheet2をアクティブ
Sheets("Sheet2").Select

'Sheet2に貼り付け
Range("B20").Select
ActiveSheet.Paste

'図形の選択解除
Range("A1").Select

End Sub

質問者からの補足コメント

• 

  補足
  横書きテキストボックスがあるシート（最初のアクティブシート）はSheet1です。

    補足日時：2017/02/20 12:36

• 

  早速のご解答ありがとうございます。
  
  軽く動作チェックしたところバッチリでした。
  
  夜以降に改めてコードを見て、お礼をさせて頂きます。
  今回はご解答ありがとうございます。

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/02/20 17:27

• 

  ご解答ありがとうございます。
  
  図形の名前って同じ名前でも同一シート上に存在出来るので、
  図形の名前の確認と変更は必要ですね。
  私も今回初めて知りました。
  
  操作は以下の通りです
  １）図形を選択する
  ２）リボンの描画ツールの書式を選択する
  ３）オブジェクトの選択と表示を選択すると
  ４）ポップアップウインドウが表示されて図形の名前が表示される
  ５）ポップアップウインドウの図形の名前の右にある「目」のアイコンで
  表示／非表示を切り替えて、図形の選択を確認する
  ６）名前の変更は「目」のアイコンの左サイドで行う
  
  というかんじですよね。
  他の方の参考のためにアップしておきます。
  
  ※画像はEXCEL2010での操作です。

  
  No.3の回答に寄せられた補足コメントです。 補足日時：2017/02/21 08:56

No.2 ベストアンサー 回答者： GooUserラック 回答日時： 2017/02/20 16:18

一応作成してみました。

汎用性を持たせるためにデータ部（場所を指定してコピー）と、処理部（図コピー）を分けてあります。
---------------------------------------------------------------------
Sub 場所を指定してコピー()
Call 図コピー("テスト1", "B10")
Call 図コピー("テスト2", "B15")
Call 図コピー("テスト3", "B20")
End Sub
---------------------------------------------------------------------
Sub 図コピー(図名 As String, 貼付位置 As String)
Dim 図番号 As Long
Const 元シート名 As String = "Sheet1"
Const 先シート名 As String = "Sheet2"
Sheets(元シート名).Select
ActiveSheet.Shapes.Range(図名).Select
Selection.Copy
Sheets(先シート名).Select
For 図番号 = 1 To ActiveSheet.Shapes.Count
If ActiveSheet.Shapes(図番号).Name = 図名 Then
ActiveSheet.Shapes(図名).Delete
Exit For
End If
Next
Range(貼付位置).Select
ActiveSheet.Paste
Range("A1").Select
End Sub
---------------------------------------------------------------------

この回答へのお礼

ご解答ありがとうございます。

返答が遅れてすいません。

まず最初にですが、変数の名前に日本語を使って頂いてありがとうございます。
まだ慣れてないので、変数が複数あると、どこまでが変数で、
どこからがVBAの構文なのか見分けるので目いっぱいという感じです。
ちょっと慣れたので、とりあえず変数を1個使うところから取り組んでいます。


で、、、肝心の内容ですが、

Callなんてステートメントがあるんですね。勉強になりました。

Callステートメントについて聞きたいこともあるのですが、、、
今、聞いてもわからないと思うので、また次回にします。

今回はご解答ありがとうございます。

追記
No.3の図形の名前の話は補足に入力しておきます。
僕も同じ名前の図形が1枚のシート上に存在出来ると知りませんでしたので。

お礼日時：2017/02/21 08:39

No.3 回答者： GooUserラック 回答日時： 2017/02/20 17:34

実はこちらも勉強させていただきました。

オートシェイプなど図形の名前って一意（重複が禁止されている）と思っていたのですが、他のシートからコピーをした場合は同じ名前でも通ってしまう事に気づきました。
本当はその辺の処理もチャントしないといけないのですが省いているのでお気をつけ下さい。

この回答へのお礼

いつもご解答ありがとうございます。

No.2に記載した通り、図形の名前の件は
補足にアップしておきました。
軽く確認して頂ければ嬉しいです。

今回はいろいろ勉強になりました。
機会がありましたらまたお願いします。

お礼日時：2017/02/21 09:00

No.1 回答者： GooUserラック 回答日時： 2017/02/20 12:41

「横書きテキストボックス(図形)の名前」と「どこに貼り付けるか」のリストみたいなものはないのでしょうか？なければ共通事項をまとめる

位であまり大した改善にはならないと思いますが必要でしょうか？

この回答へのお礼

早速のご解答ありがとうございます。

>「横書きテキストボックス(図形)の名前」と「どこに貼り付けるか」のリストみたいなものはないのでしょうか？
↓
順番にいきますね。

横書きテキストボックス(図形)の名前／貼り付ける場所
１）テキストボックス1　／　B10（Sheet2）
２）テキストボックス2　／　B15（Sheet2）
３）テキストボックス3　／　B20（Sheet2）

という感じです。

Test1、Test2のコードと同じシート、同じ場所でＯＫです。
場所の指定はRange("B10").Select　で、横書きテキストボックスの左上がB10セルのところにいきます。

「横書きテキストボックス(図形)の名前」、貼付け場所ともにTest2のコードを参照して頂いて
同じ名前と場所でＯＫです。

※こちらの書き方の方が見やすいかもです。
テキストボックス1（B10（Sheet2））、テキストボックス2（B10（Sheet2））、
テキストボックス3（B10（Sheet2））

いつもご解答ありがとうございます。
続きがあるようですので、楽しみにしております。

お礼日時：2017/02/20 13:09