Excel VBA 指定シートの取込

こんにちは。
ExcelのVBAを使用して、異なるBookのシートを取込みたいのですが、
シートが無かった場合の処理方法がわかりません。
現在のコードは下記の様になっております。

With Workbooks.Open"BOOK1.xls"
.Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
.Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1")
.Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1")
.Close
End With

Book1に指定したシートが無い場合、何もしないようにしたいのですが、
どの様に書き換えれば宜しいでしょうか？
よろしくお願いします。

No.1 回答者： mitarashi 回答日時： 2008/05/09 14:30

on error resume next を提案しようと思いましたが、エラーで止まってしまいますね。

逆に、処理対象のシートが存在するときだけ処理しては如何でしょうか。
Sub test2()
Dim sh As Worksheet
For Each sh In ActiveWorkbook
If sh.Name = "Sh1" Then
'処理
End If
If sh.Name = "Sh2" Then
'処理
End If
中略
Next
End Sub

この回答への補足

現在のプログラムは下記の様になっております。

＊フォーム＊
Private Sub CB1_Click()
If MsgBox("データ展開する？", vbYesNo, "データ展開？") = vbYes Then
Call INPORT.FILE_OPEN1
End If
End Sub

＊INPORTモジュール＊
Sub FILE_OPEN1()
Dim fnames As String
fnames = fnames1
With Workbooks.Open(Filename:=fnames)
　　.Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
　　.Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1")
　　.Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1")
　　.Close
End With
End Sub

Function fnames1() As Variant
fnames1 = Application.GetOpenFilename( _
Title:="ファイルを開く", _
FILEFILTER:="エクセルファイル (*.xls), *.xls")
End Function

補足日時：2008/05/09 15:16

この回答へのお礼

ありがとうございます。
早速試してみたのですが、

For Each sh In ActiveWorkbook

の部分で実行時エラーが出ます。
「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」
どう変更すればよいでしょうか？

お礼日時：2008/05/09 15:07

No.2 ベストアンサー 回答者： onlyrom 回答日時： 2008/05/09 15:44

シートがなくても

Sh1とSheet1
Sh2とSheet2
Sh3とSheet3
この関係が崩れないのであれば
On Error Resume Nextを●のところに入れるだけでしょう。

'-------------------------------------
Sub FILE_OPEN1()
　Dim fnames As String
　fnames = fnames1

　On Error Resume Next　　'●●ここに入れる
　
　With Workbooks.Open(Filename:=fnames)


'---------------------------
以上。
　

この回答へのお礼

出来ました！
ありがとうございます！

お礼日時：2008/05/09 15:53