複数のCSVを読み込み、一つにまとめる処理をVBAにて行っております。

複数のCSVを読み込み、一つにまとめる処理をVBAにて行っております。
（その他処理も行っておりますが、上記の処理のみ抜粋しております。）

以前ご指摘を受けたのですが、複数のCSVを一行づつ読み込むと時間がかかってしまうため、
コードを書き換えたいと思っております。

詳しい方、お手数ですが以下のコードをどのように編集すればよろしいでしょうか？
ご教授ください。

また、CSVを読み込む際、3列目に特定のワードが入っている行のみを抜粋したいとも考えているのですが、
こちらもわかる方おられましたらご教授ください。

------------------------------------

Sub LoadFiles() 'CSVファイルの読み込み
Dim CsvFileName As Variant
Dim Li As String
Dim Bf() As String
Dim r As Long
Dim ShMain As Worksheet
Dim FlNo As Integer
Dim FFlNo As Integer

Worksheets("Sheet1").Activate
With ThisWorkbook 'シート&パスの設定
Set ShMain = .Worksheets("Sheet1")
ChDrive .Path
ChDir .Path
End With

'複数のファイルの選択を可に設定
CsvFileName = Application.GetOpenFilename _
(filefilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイル選択", MultiSelect:=True)
' If VarType(CsvFileName) = vbBoolean Then Exit Sub 'キャンセル時の処置
If VarType(CsvFileName) = vbBoolean Then End 'キャンセル時終了
r = 1 '行の初期値
For FlNo = 1 To UBound(CsvFileName) 'ファイル数分ループ
FFlNo = FreeFile '---使用可能なファイル番号取得
Open CsvFileName(FlNo) For Input As #FFlNo
Do Until EOF(FFlNo) '最終行までループ
Line Input #FFlNo, Li '一行読み込み
Bf = Split(Li, """,""") 'カンマで分割し配列に代入
If UBound(Bf) >= 0 Then '空白行の処理を飛ばす
With ShMain '1行分のデータをセルに出力
.Range(.Cells(r, 1), Cells(r, UBound(Bf) + 1)).Value = Bf
End With
End If
r = r + 1
Loop
Close #FFlNo
Next FlNo
End Sub

--------------------------------------

No.2 回答者： めぐみん_ 回答日時： 2018/01/06 19:55

＞その他処理も行っておりますが、

その他が示す物は、CSVからの読み込みに関してとは全く関係のない内容なのでしょうか？
仮に１行ずつ読み込めば処理できている内容であるなら、纏めて読み込むと処理手順が変わりそうですし。
あと『空白行の処理を飛ばす』と言うのから、CSVファイルの中身がどんな感じなのか予測できないですよね。
なので『纏めて読み込む』コードに変えても結局１行ずつ調べなきゃいけないのかどうかが不明かな？

No.1 回答者： めぐみん_ 回答日時： 2018/01/05 18:29

最後の

＞また、CSVを読み込む際、3列目に特定のワードが入っている行のみを抜粋したいとも考えているのです

については、

ADOでCSVの読み込み（SQL）
http://excel-ubara.com/excelvba5/EXCEL118.html

SQL文で絞り込める『かも』しれませんね。
ただファイルが多いなら『結局時間がかかる』可能性は否定できないですし・・・・