任意のシートを選択して対象をコピー

質問

例えばsheet1のA1：B10のセルの内容を、任意に選択したシートの、任意の箇所に貼り付けるにはどの様にしたらいいのでしょうか？

考えとしては、マクロを起動させて対象範囲を選択した後、シートの選択を行い「このシートでいいですか」といったメッセージボックスを出したいです。OKなら今度は貼り付け選択のメッセージボックスを出しOKなら貼り付け。シート選択でキャンセルと選択すると別のシートの選択が出来るようにしたいのです。

ユーザーの入力指示をどの様にすればいいのか全く判らず困っています。宜しくお願いします。

回答No.2

merlionXX · ベストアンサー

Sub MyCopyPaste()
Dim CopyArea As Range
Dim PasteArea As Range
On Error GoTo ErrorHandler
Set CopyArea = Application.InputBox(prompt:= _
"コピー元を指定して下さい", Title:="コピー元", Type:=8)
Set PasteArea = Application.InputBox(prompt:= _
"貼り付け先を指定して下さい", Title:="貼り付け先", Type:=8)
CopyArea.Copy PasteArea
Exit Sub
ErrorHandler:
MsgBox "処理が取り消されました"
End Sub

ではどうでしょう？

お礼

出来ました！
教えていただいた内容を参考にすれば、使用範囲がさらに広げられますね。
今後も使わせていただきます。ありがとうございました。

回答No.1

redfox63

セルの範囲指定には Excelのワークシート関数のInputBoxを使うといいように思います

Sub Macro1()
　　dim rSrc as Rage, rDes as Range
　　Set rSrc = GetCellArea("コピー元のセル範囲を指定してください")
　　if rSrc is Nothing then
　　　　MsgBox "セル範囲が設定されていません"
　　　　Exit Sub
　　end if
　　do
　　　　Set rDes = GetCellArea("コピー先のセル範囲を指定してください")
　　　　if rDes is Nothing then
　　　　　　if vbYes = MsgBox("処理を中断しますか?", vbYesNo ) then
　　　　　　　　Exit sub
　　　　　　End if
　　　　else
　　　　　　if rDes.Cells.Count > 1 then
　　　　　　　　if vbYes = MsgBox("コピー先は単一セルの指定です" & _
　　　　　　　　　　　　　vbcrlf & "処理を中断しますか?", vbYesNo) then
　　　　　　　　　　Exit Sub
　　　　　　　　End if
　　　　　　End if
　　　　End if
　　loop while rDes Is nothing
　　rSrc.Copy rDes
End Sub

Function GetCellArea(strPrompt as String) as Range
　　dim r0 as Range
　　On Error Resume Next
　　Set r0 = Application.InputBox( strPrompt, Type:=8 )
　　GetCellArea = r0
End Function

補足

ありがとうございます。
試して見たのですが、最初のセル範囲の設定のところでどの様に選択しても、MsgBox "セル範囲が設定されていません"に移動してしまいます。
また、この部分をDimのRange宣言を解除して
rsrc = Range("F13:AI66")
としてコピー元を強制的に指定して、コピー先を選択すると、MsgBox("処理を中断しますか?", vbYesNo ) に移動してしまいます。
セル選択が悪いのでしょうか？

重ね重ね申し訳有りませんが、ご教示お願い致します。