Excel2000で、特定のシートを新規ブックに保存したい

質問

マクロ実行中のブックの特定のシートを新規ブックに保存したいのです。
特定のシートは、任意で複数枚あるとします。
但し、クリップボードや、Activeメソッド、Selectメソッドなど、
マクロ実行中に、Windowsの他のアプリケーションに
影響の出る恐れがあるロジックは使用しないとします。
また、特定のシートには、罫線や色の設定なども
してあり、新規ブックに書式も保存します。

以下のコードは、クリップボードを経由せず、セルをコピーしています。
Sub a()
Dim xlsApp As Excel.Application
Dim xlsBook As Excel.Workbook
Dim xlsSheet As Excel.Worksheet

Set xlsApp = CreateObject("Excel.Application")
Set xlsBook = Workbooks.Add　 '★１
Set xlsSheet = xlsBook.Worksheets(1)

'★２
ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _
Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200")

xlsBook.Close
xlsApp.Quit

Set xlsApp = Nothing
Set xlsBook = Nothing
Set xlsSheet = Nothing

End Sub

このコードは、ちゃんと動きます。
しかし、問題があります。
xlsApp.ScreenUpdating = False
xlsApp.Visible = False
など上記のコードに追加すると、新規ブックの操作できません。

★１の部分で、
Set xlsBook = Workbooks.Add　 としているからです
Set xlsBook = xksApp.Workbooks.Add　 とすると、
xlsApp.ScreenUpdating = False
xlsApp.Visible = False
など、新規ブックの操作ができます。

しかし、
Set xlsBook = xksApp.Workbooks.Add　 では
★２の
ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _
Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200")
で、「RangeクラスのCopyメソッドが失敗しました。」
とエラーが発生します。

何か良い方法はありますか？

回答No.5

nicotinism · ベストアンサー

No１ & No3・4 さんの流れで解決かと思いますが一応私なりの考えで。

CreateObject(Excel.Application)で新たなインスタンスを作成し、
元のExcelから新ExcelのBookに書き込もうとされているわけですが
ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _
Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200")

いくら同じExcelでも、
Copy Destination:= で別のインスタンスのBookは指示できないようです。
MSDNも覗いてみたが確たる文献は発見できず。
多分、隣家の冷蔵庫に物を突っ込むようなことはインスタンスが異なれば
Excel間でも無理なのでしょう。
なので別のインスタンスを立ち上げてやるならば

Sub test()
Dim xlsApp As Excel.Application
Dim xlsBookFrom As Excel.Workbook
Dim xlsBookTo As Excel.Workbook

Set xlsApp = CreateObject("Excel.Application")
Set xlsBookFrom = xlsApp.Workbooks.Open(ThisWorkbook.FullName, ReadOnly:=True)
Set xlsBookTo = xlsApp.Workbooks.Add

xlsBookFrom.Worksheets("Sheet1").Range("A1:D4").Copy _
Destination:=xlsBookTo.Worksheets("Sheet2").Range("E5")

xlsBookTo.Close SaveChanges:=True, Filename:="c:\test.xls"
Set xlsBookTo = Nothing

xlsBookFrom.Close SaveChanges:=False: Set xlsBookFrom = Nothing
Set xlsApp = Nothing
End Sub

こんな風かと思います。。。

お礼

すごい！なるほど、うなずけます。
完璧なコードに出会った気分です。
本当にありがとうございます。！！

回答No.4

taocat

No3.続けて登場です。

意図するところと似て非なる文言がありました。

＞原因は、２つのExcel間で処理しているにも拘わらず他のExcelをActivateしていないからだと思われます。
＞Copy,Activate,Pasteなら上手くいくはずです。

これ、２つのExcelアプリ間ですから、クリップボードを通さないといけないのでは？

という意味でした。
文章力のなさ、語彙不足はご容赦ください。

以上です。

お礼

ExcelをActivateにしなきゃいけないんですね。

回答No.3

taocat

こんにちは。
＞Set xlsBook = xksApp.Workbooks.Add　 では
＞ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _
Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200")
＞で、「RangeクラスのCopyメソッドが失敗しました。」とエラーが発生します。

原因は、２つのExcel間で処理しているにも拘わらず他のExcelをActivateしていないからだと思われます。
Copy,Activate,Pasteなら上手くいくはずです。

では、なぜ提示のコードは動作するのか、それは
＞Set xlsApp = CreateObject("Excel.Application")
＞Set xlsBook = Workbooks.Add　 '★１
このようにしてますので、xlsAppとxlsBookには何ら関係がなく、このxlsBookは現在のExcel上で動作していることになるからです。
上記のようなコードではオブジェクト変数xlsAppはあっても無意味ということになりますよね。

＞＞Applicationオブジェクトを新たに作成しているのはなぜでしょう。
＞それは、マクロの実行中に、新規ブックが表示されてしまうからです。

No1さんの回答にほんのちょっと追加して、以下をお試しください。

'----------------------------------------------------
Sub Test()

　Dim xlsBook As Workbook
　Dim xlsSheet As Worksheet

　Application.ScreenUpdating = False

　Set xlsBook = Workbooks.Add
　Set xlsSheet = xlsBook.Worksheets(1)

　ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _
　　　　　　　　　　　　　　Destination:=xlsSheet.Range("A1:D200")

　xlsBook.SaveAs ThisWorkbook.Path & "\NewBook.xls"
　xlsBook.Close

　Set xlsBook = Nothing
　Set xlsSheet = Nothing

　Application.ScreenUpdating = True

End Sub
----------------------------------------------------------

Application.ScreenUpdatingを付加
折角xlsSheetとオブジェクト変数があるのでCopy時にそれを使用

以上です。

補足

どうも、ありがとうございます。

回答No.2

nicotinism

今朝方もう一個のほうに書き込みましたが
私も「何故新たにExcelを立ち上げるのか」大いに疑問です。
既存のBookの場合ならそっちにもマクロがあってExcelを分けないと
うまく走らない・・とかは有り得るかも知れませんけど・・？

お礼

というわけです。
ありがとうございます。

補足

なぜ立ち上げるのか？
マクロ実行のブックは、CSVファイルを読み込み、シートにデータを設定します。読み込む種類のCSVファイルによって、設定されるシートの数や種類がことなります。
そして、設定されたシートだけを、マクロのない状態のブックとして、
保存したいのです。

マクロ実行のブックにシートA～Gが存在するとします
シートA
シートB
シートC
シートD
シートE
シートF
シートG

【処理の例１】
(1)CSV１取り込み
CSV1を取り込むと、シートA～Cにデータを自動で設定
(2)
シートA～Cだけを保存（マクロは、保存してはいけない）
※新規に、ブックを作成する

【処理の例２】
(1)CSV２取り込み
CSV2を取り込むと、シートD～Gにデータを自動で設定
(2)
シートD～Gだけを保存（マクロは、保存してはいけない）
※新規に、ブックを作成する

回答No.1

ham_kamo

私の勉強不足かもしれませんが、
Set xlsApp = CreateObject("Excel.Application")
とApplicationオブジェクトを新たに作成しているのはなぜでしょう。

デフォルトのApplicationオブジェクトを使って、以下のようにしたらできましたが。
（新規ブックのCloseメソッドで保存を確認するダイアログが出るのが鬱陶しかったので、勝手に名前をつけて上書き保存するように変えています）

Sub a()
Dim xlsBook As Excel.Workbook
Dim xlsSheet As Excel.Worksheet

Application.ScreenUpdating = False

Set xlsBook = Workbooks.Add
Set xlsSheet = xlsBook.Worksheets(1)

ThisWorkbook.Worksheets("Sheet1").Range("A1:D200").Copy _
Destination:=xlsBook.Worksheets("Sheet1").Range("A1:D200")

xlsBook.Close SaveChanges:=True, Filename:="New.xls"
Application.ScreenUpdating = True

Set xlsBook = Nothing
Set xlsSheet = Nothing

End Sub

お礼

ありがとうございます。
ちゃんと、動くようになりました。
インスタンスの作成に、もっと注意いたします。

補足

Set xlsApp = CreateObject("Excel.Application")
とApplicationオブジェクトを新たに作成しているのはなぜでしょう。

それは、マクロの実行中に、新規ブックが表示されてしまうからです。
xlsApp.Visible = True としないかぎり、画面には、表示しなくて済むからです。
マクロの実行中に、新規ブックの内容は、表示させたくないのです。