VBA 異なるファイルを指定して文字を抜き出す

質問

エクセルVBAについてご質問させて頂きます。
お詳しい方、ご教授頂ければ幸いです。

ファイルＡを展開中に、別ファイルであるファイルＢ（ユーザ指定）の特定シートのセル「Ｄ2」及び「Ｅ2」から下のデータを順番に参照し、条件に合致する列のセル「Ｂ２」及び「Ｃ2」の文字列を繋げて改行し、
ファイルＡの特定シートのセル「Ｅ2」から下に順番に貼り付けて行くには、
どのようにすれば良いでしょうか。

例
　　条件：　Ｄ2=さ　Ｅ２＝た　

　　　・ファイルＢ（指定）　特定シート
　　　　　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｅ
　　　１
　　　２　　　0　　　　あ　　　　か　　　　さ　　　　た
　　　３　　　0　　　　あ　　　　き　　　　さ　　　　た
　　　４　　　0　　　　い　　　　か　　　　さ　　　　ち
　　　５　　　0　　　　い　　　　き　　　　さ　　　　た
　　　６　　　0　　　　う　　　　か　　　　し　　　　た
　　　７　　　0　　　　え　　　　か　　　　し　　　　ち
　　　８　　　0　　　　え　　　　か　　　　し　　　　た

　　　・ファイルＡ特定シート
　　　　　　Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　Ｅ
　　　１　　　　　　　　

　　　２　　　　　　　　　　　　　　　　　　　　　　あ
　　　　　　　　　　　　　　　　　　　　　　　　　　か

　　　３　　　　　　　　　　　　　　　　　　　　　　あ
　　　　　　　　　　　　　　　　　　　　　　　　　　き

　　　４　　　　　　　　　　　　　　　　　　　　　　い
　　　　　　　　　　　　　　　　　　　　　　　　　　き

　実力不足で丸投げの形となってしまい申し訳ありませんが、
よろしくお願い致します。

回答No.2

imogasi

何かＶＢＡコード化をやってみたのか。何処が行き詰まっている点か、質問には絞って質問すること。質問者の勉強態度としてそれが上達の途と思う。丸投げになっている。
ーー
＞ファイルＡを展開中
VBAモジュールにこのプログラムを書くということになる。
＞別ファイルであるファイルＢ（ユーザ指定）の特定シートのセル
毎回指定するファイル名、シート名は変わるのか。それに対応したいのか。しかし
まづ固定で勉強してコードを作ったら。
初心者と上級者が「特定の」という言葉を好むが、勉強には、まずファイル名やシート名を決めて勉強し
全体が動くようになって、相対化（都度指定化）を考えるべきでしょう。
＞データを順番に参照し
セルの値を取るだけ。全行のＤ，Ｅ列のセルの値を取るコードなど、このコーナーの回答にも毎回出てくるだろう。
Ｆｏｒ　Ｎｅｘｔで出来るのでは？。
＞条件に合致する列の
とは何？条件は何処のある？質問に書いてますか？
検索と表現すると判りやすい。検索文字列は？検索する範囲は？
ＲａｎｇｅのＦｉｎｄメソッドを使うなど、考えが及んでますか？
シートの検索操作で「マクロの記録」でも採ってコードを勉強しましたか？
＞セル「Ｂ２」及び「Ｃ2」の文字列を繋げて改行
＆でつなげば仕舞い。
なぜセル「Ｂ２」及び「Ｃ2」の文字列、と固定して第２行目なの？見つかった行のＢ，Ｃ列ではないの？
ーー
＞特定シートのセル「Ｅ2」から下に順番に貼り付けて行くには
貼り付けるデータ範囲の最下行を取得し、その＋１行（直下行）に書き込めば仕舞い。
最下行の行番号ポインターを変数で持つ手もある。
＝＝＝＝
（１）どのセルの文字列で検索するのか
（２）どの範囲を検索対象範囲にするのか
（３）行が見つかったらどうするのか。その行のＢ列＆Ｃ列をファイルＡの最下行に代入するのかな？
よく考えないで安易に質問文を書いていると思う少し緻密に考えることが必要。

回答No.1

o_chi_chi

下記でどうでしょう

取得範囲および項目は実際に合わせて変更のこと
--
Sub test()
Dim strSql As String
Dim cnXL As Object
Dim rsXL As Object

Set cnXL = CreateObject("ADODB.Connection")
Set rsXL = CreateObject("ADODB.Recordset")

With cnXL
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & ThisWorkbook.FullName & "; ReadOnly=True;"
.Open
End With

strSql = "select '','','','',B & Chr(13) & Chr(10) & C " _
& " FROM [Sheet1$A1:E8] " _
& " WHERE D = 'さ' and E = 'た' "
Debug.Print strSql
rsXL.Open strSql, cnXL, adOpenForwardOnly

Worksheets("sheet2").Cells(1, 1).CopyFromRecordset rsXL

rsXL.Close: Set rsXL = Nothing
cnXL.Close: Set cnXL = Nothing
End Sub