シートを複写して既にあるブックの中に挿入したい

質問

Excel2007でマクロ作成中の初心者です。

現在下記のコードにより、自分のＰＣ、他のＰＣで正常に、マクロ実行しています。
1）このマクロは、年間１２個のブックができますので、加工が面倒です。そのため
これを、デスクトップのフォルダ「実績綴り」内の、「年間集計表」というブックの
　最前列のシートの前に追加していきたいのです。そうすれば、１年分がひとつのブックに
保存されるので何かと便利です。
3）追加するシート名が、無いときは問題ないですが、既にある場合は、複製が挿入されるので
　最新のシートと古いシートが混在してしまいます。何か工夫はないでしょうか

。以上よろしくご指導をお願いします。

’--------------------------------------------
Sub シートの保存() ' 現在使用しているマクロコード

’1）ブックには、シートの名「月売上」がある。
’2）このシートを複写して、新規ブックを作成する。
’3）このシートの「月売上」セル「Ｒ４の値」を、新規ブック名とする。
’4）保存先は、デスクトップのフォルダ「実績綴り」とする。
’5）セル「Ｒ４の値」が変更されない限り、上書きされるので、データは常に最新である。

Application.ScreenUpdating = False
'Const cnsTITLE = "マクロなしブックの作成"
'Const cnsFILTER = "Excelワークブック (*.xls),*.xls"
Dim xlAPP As Application
Dim WBK1 As Workbook ' 本ブックの
Dim WBK2 As Workbook ' 作成ブック
Dim strFileName As String
Dim tblSH As Variant
Dim lngLines As Long
Dim myDate As String
Worksheets("月売上").Select
myDate = Range("R4").Value

Set WBK1 = ThisWorkbook ' 本ブック
' 指定シートを新規ブックにコピーする
Worksheets("月売上").Copy
Set WBK2 = ActiveWorkbook
strFileName = Format(myDate, "ge年m月度") & ".xls"
Dim Path As String, WSH As Variant
Set WSH = CreateObject("Wscript.Shell")
Path = WSH.SpecialFolders("Desktop") & "\実績綴り"
Set WSH = Nothing
ChDir Path
Application.DisplayAlerts = False
WBK2.SaveAs "月売上" & strFileName, FileFormat:=XlFileFormat.xlExcel8
Application.DisplayFormulaBar = True
WBK2.Close False
Application.DisplayAlerts = True
Set WBK2 = Nothing
MAKE_NEWBOOK_WO_MACROS_EXIT:
Set WBK1 = Nothing
Set xlAPP = Nothing
End Sub

回答No.3

watabe007 · ベストアンサー

>Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\実績綴り"の
>Path =　が黄色くなり、コンパイルエラー　変数が定義されていません。
おかしな現象ですね、貴方がアップされた
Set WSH = CreateObject("Wscript.Shell")
Path = WSH.SpecialFolders("Desktop") & "\実績綴り"
にはエラーが出なくて私のには出たわけですね・・・

おそらく変数の宣言をされていないからですね
Dim Path As String

ただ、貴方の書かれたPathを流用しましたがPathはPathプロパティとして使われますので
myPath などとしたほうが良いですね

Dim myPath As String
Dim WBK As Workbook
Dim SN As String
myPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\実績綴り"
Set WBK = Workbooks.Open(myPath & "\年間集計表.xls")
With ThisWorkbook.Worksheets("月売上")
SN = Format(.Range("R4").Value, "ge年m月度")
'On Error Resume Next
'※既に年間集計表に"ge年m月度"が有れば削除
'WBK.Worksheets(SN).Delete
'On Error GoTo 0
'"ge年m月度"シートを年間集計表の最前列のシートの前に追加
.Copy Before:=Workbooks("年間集計表.xls").Sheets(1)
End With
ActiveSheet.Name = SN
'年間集計表を上書き保存
WBK.Close True

お礼

今日朝５時におきて、貴方様から教えていただいたコードを印刷し、何度も試しているうちに、完璧に思ったとおりの動作を確認しました。これで作業が１２分の一以上に軽減されることになりました。感謝かんげきです。たくさんのお時間を割いてくださり本当にありがとうございます。またご指導いただくことありましたらよろしくお願いします。本当にありがとうございました。

補足

Set WBK = Workbooks.Open(myPath & "\年間集計表.xls")
c:￥user￥aaaaa￥desktop￥実績綴り￥年間集計表.xlsが見つかりません。ファイル名がだたしいかどうか・・が出ます。確かに、年間集計表.xlsは存在してるのに・・・。
お世話かけてもうしわけありません。どうしてなのでしょうか？

回答No.4

watabe007

>Set WBK = Workbooks.Open(myPath & "\年間集計表.xls")
>c:￥user￥aaaaa￥desktop￥実績綴り￥年間集計表.xlsが見つかりません。

年間集計表の拡張子が xlsx とか　xlsm などではないでしょうか？

補足

自分もそう思い確認しましたが、拡張子は、xls　になってます。
Set WBK = Workbooks.Open(myPath & "\年間集計表.xls")
の前に
MsgBox "現在のカレントフォルダは" & vbCrLf & _
CurDir & vbCrLf & "です。"
をつけたところ、現在のカレントフォルダは
c:￥user￥aaaaa￥desktop￥このマクロが入っているフォルダ　　・・・が表示されますけど、これは
別によろしいでしょうか。

回答No.2

watabe007

参考に

　　'実績綴りのパス取得
　　Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\実績綴り"
　　'年間集計表オープン
　　Set WBK = Workbooks.Open(Path & "\年間集計表.xls")
　　'最前列のシートの前に追加していきたいのです
　　With ThisWorkbook.Worksheets("月売上")
　　　　SN = Format(.Range("R4").Value, "ge年m月度")
　　　　'On Error Resume Next
　　　　'※既に年間集計表に"ge年m月度"が有れば削除
　　　　'WBK.Worksheets(SN).Delete
　　　　'On Error GoTo 0
　　　　'"ge年m月度"シートを年間集計表の最前列のシートの前に追加
　　　　.Copy Before:=Workbooks("年間集計表.xls").Sheets(1)
　　End With
　　ActiveSheet.Name = SN
　　'年間集計表を上書き保存
　　WBK.Close True

補足

'実績綴りのパス取得
　　Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\実績綴り"の
Path =　が黄色くなり、コンパイルエラー　変数が定義されていません。のエラーがでるのですが回避の方法教えてください。

回答No.1

Siegrune

Worksheets("月売上").Copy
の代わりに
Sheets("月売上").Copy Before:=Workbooks("年間集計表").Sheets("（前月のシート名）")
とするなり、
"（前月のシート名）"を
1かWorkbooks("年間集計表").sheets.countにするかしたら
できると思います。
Before:=は指定したBook.Sheetの前にコピーするというパラメタ。

補足

ごしてきのとおり
Sheets("月売上").Copy Before:=Workbooks("年間集計表").Sheets（1）
やってみましたがうまくいきません。
Copyするときは、両方のブックが開いた状態でないと、うまくいかないときいています。
とすると
Set WBK2 = ActiveWorkbook　でなくSet WBK2 =デスクトップのフォルダの中の年間集計表を指定しなくてよろしいのでしょうか？