セルの値に応じてシート間をデータ移動させたい

質問

シート名が
「1」
「2」
「3」
「4」
「5」
という５つのシートがあります。

A2とA4にデータが入力されていて、
D4とI4に入力した値（シート名）に応じて、
マクロでシート間をデータ移動させたいのですが、
どなたかおわかりの方がいらっしゃいましたら教えて下さい。

（移動先にデータが存在する場合は上書きして問題ありません）

例）
D4に「1」 I4に「3」と入力して実行すると、
シート「1」からシート「3」にA2とA4の値が移動するマクロを作成したい。

回答No.5

SI299792 · ベストアンサー

すみません、移動でしたね。
　　Sheets(InpSheet).[A2,A4].ClearContents
を
　　Exit Sub
の上に入れて下さい。
質問はよく読むべきですね。

お礼

幾度もの補足にも迅速にお答えいただき恐縮です。
これで作業にかかる時間が大幅に短縮できます。
あらためましてありがとうございました。

回答No.4

SI299792

#1です。
すみません。
シートが「1」「2」「3」「4」「5」だけで、他のシートはないという設計をしてしまいました。
そんな訳ありませんよね。実際は画像のようなコントロールシートを別に設けますよね。
で、改造版です。
'
Option Explicit
'
Sub Macro1()
'
　　Dim InpSheet As String
　　Dim OutSheet As String
'
　　InpSheet = [D4]
　　OutSheet = [I4]
　　On Error GoTo 100
　　Sheets(OutSheet).[A2] = Sheets(InpSheet).[A2]
　　Sheets(OutSheet).[A4] = Sheets(InpSheet).[A4]
　　On Error GoTo 0
　　Exit Sub
100 '
　　If Err = 9 Then
　　　　MsgBox "指定シートがありません", vbCritical
　　Else
　　　　Error Err
　　End If
End Sub

補足

改造版ありがとうございます。
説明が稚拙で申し訳ありません。

データは移動したのですが、
移動元から移動先へコピーされていて、
移動元のデータが削除（クリア）されていないのです。

（「移動」という表現が良くなかったのかと思います）

移動元のデータを削除（クリア）する方法につきまして、
併せてご教授いただければ幸いです。

回答No.3

imogasi

・＞A2とA4にデータが入力され
シートを明記してないのがわかりにくい。
・「移動」なんていう画像が見えるが、ボタンでも設けて、
クリックしたら、質問のことを実現したいのか。ー－＞そう解釈した。
質問者のレベルではそこまでしない方がよいと思うが。
・シート名を「１」・・と言っているが、
ー＞シート名は「文字列」で指定しないとダメ、というのは知っているのかな。
こういうのは、イーと名に普通避けるのでは。
そこで、「１」「３」は全角数字の１、３とした。
ここが本件を難しくしていると思う。
ーー
シート１に図形の四角を設けて、そのクリックイベントにマクロを登録した。
ーー
Sub 正方形長方形1_Click()
test01
End Sub
ーー
test01　は、具体的には、標準モジュールに
Sub test01()
Dim s1 As String
Dim s2 As String
s1 = StrConv(Worksheets(1).Range("D4"), vbWide)
MsgBox s1
s2 = StrConv(Worksheets(1).Range("I4"), vbWide)
MsgBox s2
MsgBox Worksheets(s1).Range("A2")
MsgBox Worksheets(s1).Range("A4")
Worksheets(s2).Range("A2") = Worksheets(s1).Range("A2")
Worksheets(s2).Range("A4") = Worksheets(s1).Range("A4")
End Sub
MsgBoxの行は、テスト確認用なので、本番では省くこと。
ーーー
シート「１」のデータ例のイメージ
123 ＜－A2 この辺に「ボタンを貼り付け」

345 ＜－A4 1 ＜－D4 3＜－I4
シート「３」のイメージは省略
勘違いしているようなら、すみません、無視して。
＝＝
本件は、Excel関数でもできるのでは。

回答No.2

mt2015

あくまでサンプルですのでエラー処理は入れていません
Sub sample()
　　Sheets(Range("D4")).Range("A2").Cut Sheets(Range("I4")).Range("A2")
　　Sheets(Range("D4")).Range("A4").Cut Sheets(Range("I4")).Range("A4")
End Sub

回答No.1

SI299792

シート名を入れた後、ボタンを押すという設計です。
'
Sub Macro1()
'
　　On Error GoTo 100
　　Sheets([I4]).[A2] = Sheets([D4]).[A2]
　　Sheets([I4]).[A4] = Sheets([D4]).[A4]
　　On Error GoTo 0
　　Exit Sub
100 '
　　If Err = 9 Then
　　　　MsgBox "指定シートがありません", vbCritical
　　Else
　　　　Error Err
　　End If
End Sub

補足

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

試してみたのですが、データが移動せず、
指定シートがありませんの表示が出ます。
指定セルやシート名を変更してみても同じでした。

もう少し検証してみたいと思うのですが、
次は明日の夜か明後日の朝になりそうです。