データファイルを開かずにコピー、別ファイルに転記

質問

データファイルを開かずに、該当行をコピー、別ファイルに転記する方法を教えてください。

・ユーザーフォームを持つファイルがあります（仮ファイル名：印刷用ツール.xls）
　ユーザーフォームには、テキストボックス（番号入力用）と、コマンドボタンがひとつあります
　印刷用ツール.xlsのSheet1は「印刷用シート」になっています。
　印刷用ツール.xlsのSheet2は、「印刷用シート」に表示するためのデータが入るデータシートです。

・↑とは異なるデータファイルがあります（仮ファイル名：データファイル.xls）
データファイルには
A列に番号　、B～D列には番号に付随する情報データが入力されています。
（例）　
A　　　B　　　C　　　D　
1　　りんご　青森　150
2　　いか　　新潟　200

***以下、実行したい内容のイメージです

(1)ユーザーフォームのテキストボックスに番号を入力して、コマンドボタンを押す
↓
(2)テキストボックスに入力された番号と同じ番号をデータファイル.xls内で検索する（データファイル.xlsを開かずに）
↓
(3)データファイル内で検索して合致した番号行を行ごとコピーする
↓
(4)コピーしたデータを印刷用ツール.xlsのSheet2の1行目に貼り付ける（貼り付ける前にSheet2の1行目をクリアする）

（後は、Sheet2のデータはSheet1（印刷用シート）で、表示したい部分だけを表示して印刷します）

宜しくお願い致します。

回答No.3

keithin · ベストアンサー

スミマセン，なんだかあちこち書き間違えてました。

private sub CommandButton1_Click()
　dim Target as range
　application.screenupdating = false
　workbooks.open filename:="c:\test\データファイル.xls"

　set target = workbooks("データファイル.xls").worksheets(1).range("A:A").find(what:=me.textbox1, lookin:=xlvalues, lookat:=xlwhole)
　if target is nothing then
　　workbooks("データファイル.xls").close false
　　application.screenupdating = true
　　msgbox "not found"
　　exit sub
　end if

　target.entirerow.copy destination:=thisworkbook.worksheets("Sheet2").range("A1")
　workbooks("データファイル.xls").close false
　application.screenupdating = true
end sub

大変失礼しました。

お礼

できました！！！
速度も速いです！

丸々書いて頂いた上に、最後までご確認頂いて、本当に本当にありがとうございました！

回答No.2

keithin

ん？　おっとスミマセン，単純な誤記してましたね

まちがい
workseets

正解：
worksheets

失礼しました。

お礼

自分で発見できずすみません、、＾＾；

ただ、ｈを入れてもまだ同じエラーが出てしまいました・・・
変わらず「target　=」のところが反転してます。。

私ももう一回コードを見てみます！

回答No.1

keithin

マクロの基本的な理解として，「ブックを開かずにコピーしてくる」方法はありません。
ブックを開かず処理するためは，ワークシート上で数式を使用して該当ブックの値を検索や参照します。

繰り返すと，できることは次のどちらかです。
１．諦めてブックを開いてコピーしてくる
２．ブックを開きたくないので，数式を工夫して少しでも高速化する

ケース１）
「開かずに」開いてコピーして閉じる。
private sub CommandButton1_Click()
　dim Target as long
　application.screenupdating = false
　workbooks.open filename:="c:\test\データファイル.xls"

　set target = workbooks("データファイル.xls").workseets(1).range("A:A").find(what:=me.textbox1, lookin:=xlvalues, lookat:=xlwhole)
　if target is nothing then
　　workbooks("データファイル.xls").close false
　　application.screenupdating = true
　　msgbox "not found"
　　exit sub
　end if

　target.entirerow.copy destinaton:=thisworkbook.worksheets("Sheet2").range("A1")
　workbooks("データファイル.xls").close false
　application.screenupdating = true
end sub

ケース２）
事前にシート２のＢ１セルに
=MATCH(A1,'c:\test\[データファイル.xls]Sheet1'!A:A,0)
と数式を準備しておく
Ａ２セルに
=INDEX('c:\test\[データファイル.xls]Sheet1'!A:A,$B$1)
と数式を準備して右に必要な列範囲までコピーしておく

private sub commandbutton1_Click()
　worksheets("Sheet2").range("A1") = me.textbox1
end sub

シート２は，たとえばシート自体を非表示にしておく。

お礼

続けてのご解答ありがとうございます！

ファイル名、ファイル場所等を書き換えて早速やってみたのですが、
「コンパイルエラー：オブジェクトが必要です」というエラーになります。
書き換え時にファイル名を間違えたり、場所の指定を間違えたかな？と
思って確認したんですがわからず・・・

エラー時は、コードの
「private sub CommandButton1_Click()」が黄色くマーカーされ
「Set　target」のところが青く反転されます（選択された状態になります）

補足

すみません、お礼の内容ですが、
ケース1）のコードでやってみた結果です。