シートをコピーするマクロ

質問

エクセルファイルを二つ開いているとします。
現在のアクティブシートを、もうひとつのファイルの最後のシートの後ろにコピーするマクロを教えてもらいたいのですが。
もうひとつのファイル名はそのつど変えることなく、汎用性がもてれば助かります。

以上、よろしくお願いいたします。

回答No.2

zap35 · ベストアンサー

＞エクセルファイルを二つ開いているとします
が前提であれば下記マクロでよいでしょう。でも「汎用的」に作るとなれば、Bookが三つ以上開いている場合も考えなければなりません。その時はどのシートに複写するのでしょうか。

汎用性が必要ならもう少し条件を明示しないと難しいです。サンプルをヒントに手を入れてみてください。

Sub Macro1()
Dim trgBK As String, k
　If Workbooks.Count = 2 Then
　　If Workbooks(1).Name = ActiveWorkbook.Name Then
　　　trgBK = Workbooks(2).Name
　　Else
　　　trgBK = Workbooks(1).Name
　　End If
　　ActiveSheet.Copy _
After:=Workbooks(trgBK).Sheets(Workbooks(trgBK).Worksheets.Count)
　Else
　　k = MsgBox("開いているBOOKが２つではありません", vbOKOnly + vbCritical)
　End If
End Sub

お礼

有難うございます。

実行してみましたが、ブック2つなのに、「BOOKが2つではありません」が表示され、コピーは行われませんでした。
また、「汎用性」というのは、対象ブック名をそのつど明記する必要がないという点についてのみのことです。
実行する時は常にブック2つの状態で行います。

回答No.5

zap35

＃０２です
すみませんです。閉じ括弧”）”をNameの後ろにつけてください。

お礼

わかりました。
個人用マクロブックがカウントされていました。
Macro1を修正して再試行したら、成功してます。
いろいろと有難うございました。

回答No.4

zap35

＃０２です。そうですか、変ですね。
　If Workbooks.Count = 2 Then
はかなり確実な確認方法なのですが…　では、エラーにあるとき下記マクロを実行してみてください。お手数ですがその結果を教えてください

SUB Macro2()
　MSGBOX("開いているWorkbook数=" & Workbooks.Count)
　MSGBOX("Workbook(1)=" & Workbooks(1).Name
　MSGBOX("Workbook(2)=" & Workbooks(2).Name
　MSGBOX("Workbook(3)=" & Workbooks(3).Name
　MSGBOX("Workbook(4)=" & Workbooks(4).Name
End Sub

途中でエラーになっても構いません。想像ではXLSTARTにEXCEL起動時に自動で開くBOOKがあるのかな？　と思います。

お礼

有難うございます。

Macro2をEditerに貼り付けただけで、下の4行が赤色になってしまいます。

回答No.3

ctrlzr

1は、もうひとつのファイルの最後のシートにコピってませんでした。2の方の回答でOKです。

回答No.1

ctrlzr

Module1に以下のソースを丸コピしてください
--------------------------------------------
Option Explicit

Public Sub copysheet()

Dim bk As Workbook
Dim sh As Worksheet

Set bk = ActiveWorkbook
Set sh = bk.ActiveSheet

sh.copy after:=bk.Worksheets(bk.Worksheets.Count)

End Sub

お礼

有難うございます。

同じブック内にコピーされてしまいます。