エクセル2007VBAで新規ファイルを作る場合

質問

現在Ａ社というファイルのsheet1に電気代と名前を付けたデータ、sheet2に
ガス代という名前を付けたデータがあり電気代のブックからコピーして新規ファイルに貼り付けをしたいと思い下記のとおりマクロがありますが、新規ブックを開いた時常に1ではなく他に新規ブックを開いていたら２とか３になってしまいます。すると再度新規ブックに戻ってガス代を貼り付ける時２とか３ｔｐか４とかでしたらエラーになってしまいます。
こういう場合どのように書いたら良いのでしょうか？
それから最後に新規ファイルで名前を付けて保存のところまでダイアログ出すところまで
教えていただきたいのですが。
マクロ勉強始めたばかりでよろしくお願います。

Sub DGCopy()
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "電気代"
Windows("A社.xls").Activate
Sheets("電気代").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Book1").Activate
Sheets("Sheet2").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "ガス代"
Application.CutCopyMode = False
End Sub

回答No.1

某HN クロメート(Chromate)（@CoalTar） · ベストアンサー

VBA勉強中のみだけど
Sub DGCopy2()
Sheets(Array("電気代", "ガス代")).Copy
End Sub
かな？

お礼

解答ありがとうございます。
ちょっと意図している物と違う木がします。
すみません。

回答No.5

某HN クロメート(Chromate)（@CoalTar）

＞ごめんなさいね。合ってます。
良かったです。一応、検証して回答しているので。

＞Application.SendKeys "%FA"も
＞Application.SendKeys "^s"も何も動かないのですが
XL2002だと動いたけど、XL2003で動かなかったのでなんか不安定みたい。意味は
[ALT]+[F]-[A]ファイル名を付けて保存
[Ctrl]+[S]上書き保存(新規ブックなのでファイル名を付けて保存)

>どこでどのように勉強したのですか？
マクロの自動記録がメインで本はすぐ飽きてしまって、、、

>VBAが仕事ですか？
VBAは欲しい結果を出すための時間短縮ツールでしかなく、ほとんど使わない。

>f = Application.GetSaveAsFilename(FileFilter:="Excelブック (*.xlsx),*.xlsx)")
参考にさせていただきます。m(_ _)m

お礼

わかりました。
大変勉強になりました。
また、宜しくお願いします。

回答No.4

某HN クロメート(Chromate)（@CoalTar）

＞ちょっと意図している物と違う木がします。
どのあたりが違うか指示してくれるとお互いの勉強になります
シート名が入れ替わるのかなあ？

Sub コピーして保存()
　　'シート上で[Alt]+[F8]上記実行
　　Sheets(Array("電気代", "ガス代")).Copy
　　Application.SendKeys "%FA"
End Sub

とか
A社限定？
Sub コピーして保存2()
　　Workbooks("A社").Sheets(Array("電気代", "ガス代")).Copy
　　Application.SendKeys "^s"
End Sub

お礼

解答ありがとうございます
ごめんなさいね。合ってます。
no,2の方の下記を追加したらこれで全てＯＫです。
ホントごめんなさいね。

ちなみに
Application.SendKeys "%FA"も
Application.SendKeys "^s"も何も動かないのですが
どうなるはずなんでしょうか？

それから勉強中の身との事ですが、もうプロ並みじゃあないですか
どこでどのように勉強したのですか？
VBAが仕事ですか？

Sub コピーして保存1()
Sheets(Array("電気代", "ガス代")).Copy
f = Application.GetSaveAsFilename(FileFilter:="Excelブック (*.xlsx),*.xlsx)")
End Sub

回答No.3

hallo-2007

No1の方のアイディアの通り、必要なシートを最初からすべてコピーしておけば完了ですね。
＞マクロ勉強始めたばかりでよろしくお願います。
なので少し説明しておきます。
マクロの記録で作成されたコードだと思いますが、
セルやシートを指定するのに　Activeworkbook と　Thisworkbook　でブックを指定することが出来ます。
それと　Copy　のコマンドだけで　貼り付ける先も指定できます。
http://www.officetanaka.net/excel/vba/cell/cell09.htm
のあたりが参考になりますでしょうか。
つまり

Workbooks.Add
ThisWorkBook.Sheets(1).Cells.Copy Activeworkbook.Sheets(1).Cells
・・・・
といった感じで、元のブックのシートを　新しく開いたブックのシートへ　コピー
といった感じですね。
Activeworkbookは省略もできますし、
With　を使って　With　ThisWorkbook 指定して

Workbooks.Add
With ThisWorkbook
.Sheets(1).Cells.Copy Sheets(1).Cells
.Sheets(2).Cells.Copy Sheets(2).Cells
・・・・・
End With
という記述の方法もあります。

＞それから最後に新規ファイルで名前を付けて保存のところまでダイアログ出すところまで
教えていただきたいのですが。
VBA　ダイアログ　などで検索してみると沢山見つかります。
http://www.happy2-island.com/excelsmile/smile03/capter00804.shtml
などは如何でしょうか。

お礼

解答ありがとうございます。
こんなに簡単になるんですね。
驚きました。

それよりも、NO,1の方で正解ですね。
これこそ驚きで、arrayこの１行で全て解決ですね。
arrayを使った欠点ってあるんでしょうか？

補足

withを使ってやってみましたが、worksheetクラスのselectメソッドが失敗しましたと出ます。
Sub DGCopy()
Workbooks.Add
With ThisWorkbook
.Sheets(6).Cells.Copy Sheets(1).Cells
.Sheets(1).Select
.Sheets("Sheet1").Name = "電気代"
.Sheets(7).Cells.Copy Sheets(2).Cells
.Sheets(2).Select
.Sheets("Sheets2").Name = "ガス代"
End With

.Sheets(1).Select
.Sheets("Sheet1").Name = "電気代"
ここはどのように書けば良いでしょうか？
宜しくお願いします。

回答No.2

doara_2011

＞新規ブックを開いた時常に1ではなく他に新規ブックを開いていたら
＞２とか３になってしまいます。
は、新規ブックのタイトルの文字列が常に"Book1"でないと言っているのかな？
だから
＞Windows("Book1").Activate
を実行しようとした時にエラーになったと言うこと？ 質問する時には、どこでエラーに
なったかを明記してくれると、答える方としては楽なんですが。
であるなら 上記の代わりに Workbooks(Workbooks.Count).Activate でどうでしょうか？
最後に開いたワークブックをアクティベートする、と言う意味です。

＞それから最後に新規ファイルで名前を付けて保存のところまでダイアログ出すところまで
ダイアログはApplicationオブジェクトのGetSaveAsFilenameメソッドを使って出します。
f = Application.GetSaveAsFilename(FileFilter:="Excelブック (*.xlsx),*.xlsx)")
上記はダイアログを表示して、入力されたファイル名を取得するだけの機能しかない
(つまり、保存は別で行う必要がある)ので
If f = "False" Then Exit Sub　　　　　　　' ダイアログでCancelをクリックした場合
ActiveWorkbook.SaveAs Filename:=CStr(f)
とする。

以上

お礼

大変、ありがとうございます。
出来ました。
それからこのマクロをもう少し簡単にとういか短くするとなると
どういう書き方になるのでしょうか？
すみませんが、よろしくお願いします