Excel VBA 違うxlsファイルの指定したシートを開く処理

質問

Excel VBAで違うExcelファイルの指定したシートを開きたいのですが、
うまくいきません。現在のコードは、

＊フォーム＊
Private Sub CB1_Click()
Dim A As Integer
A = MsgBox("データ展開する？", 4, "データ展開？")
If A = 6 Then
INPORT.FILE_OPEN1
End If
End Sub

＊INPORTモジュール＊
Sub FILE_OPEN1()
　FILE_OPEN8
End Sub

Sub FILE_OPEN8()
Dim fnames As String
fnames = fnames1
Workbooks.Open Filename:=fnames
＊＊＊ここでしょうか？.Sheet("")と指定しても出来ません＊＊＊
End Sub

Function fnames1() As Variant
fnames1 = Application.GetOpenFilename( _
Title:="ファイルを開く", _
FILEFILTER:="エクセルファイル (*.xls), *.xls")
If fnames1 = False Then
MsgBox ("ファイルを開けませんでした。" & Chr$(13) & _
"もう一度やり直して下さい。")
End
End If
End Function

また、指定する事が出来たら、選択したシートを現在のブックにコピーもしたいのですが、どの様にすればよいでしょうか？
よろしくお願いします。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

>エラーの内容は、
実行時エラー'1004';
>「アプリケーションの定義またはオブジェクト定義のエラーです。」

というのは、

With Workbooks.Open(Filename:=fnames)
'******************
　.Worksheets(1).Select '指定する
　'ボタンのあるシートにコピーする
　.Worksheets(1).Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")　
　'ボタンのあるシートに戻る
　Application.Goto ThisWorkbook.ActiveSheet.Range("A1")　
End With

の　*******　の部分に何か入って、アクティブブックが、「Workbooks.Open(Filename:=fnames)」と開いたブックでない場合に、そのような文言のエラーが発生します。

もし、必要とあれば、この2行をセットに使ってください。

　.Activate
　.Worksheets(1).Select '指定する

コピーするだけなら、単に、このコードだけで足ります。
　.Activate さえ必要ありません。

　.Worksheets(1).Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")

お礼

出来ました！
丁寧なご指導ありがとうございました！

回答No.1

Wendy02

こんにちは。

>指定する事が出来たら
With ステートメントを使います。シートを指定しないのなら、その開いたブックのActiveSheet になります。選ぶなら、InputBox 関数やメソッドを用いて、選ばせます。
Copy は、Cells と、シート全体を取得しています。

Sub FILE_OPEN8()
Dim fnames As String
fnames = fnames1
With Workbooks.Open(Filename:=fnames)
　.Worksheets(1).Select '指定する
　'ボタンのあるシートにコピーする
　.Worksheets(1).Cells.Copy ThisWorkbook.ActiveSheet.Range("A1")　
　'ボタンのあるシートに戻る
　Application.Goto ThisWorkbook.ActiveSheet.Range("A1")　
End With
End Sub

なお、通常、MsgBox のYes/No は、こんな書き方をします。

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

お礼

ありがとうございます。
早速コードを変更してトライしてみたのですが、
下記でどうしてもエラーがでます。

With Workbooks.Open(Filename:=fnames)
　.Worksheets(1).Select '指定する　　＊ここでエラー＊
End With

どうしたらよろしいでしょうか？
MsgBoxの件ありがとうございました。
すぐに変更いたしました！

補足

エラーの内容は、
「アプリケーションの定義またはオブジェクト定義のエラーです。」
と出ます。
使用しているのはPersonal Edition のExcel2003です。