エクセル マクロ VBA 編集 修正依頼

現在使用している、ある検索用のマクロファイルがあります。 別の複数シートに～30万行ほどのデータがあり、随時追加されていきます。 検索用のシートに、キーワードを入力すると、 データ用のシートを探しにいき、 その検索用のシートに反映させるようなファイルなのですが、 このファイルが30MBくらいで、かなり重くなってきてしまったので、 データ用のファイルと検索マクロ用のファイルを切り離すなどして、 もっとサックりと検索できるようなマクロファイルを作りたいです。 下記は、現在のマクロです。 ファイル自体は OneDriveの直下に保存してあります。 お詳しい方、編集などが可能な方いましたら、どうぞよろしくお願いいたします。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Sub Sample() Dim st1 As Worksheet, st2 As Worksheet Dim i As Long, kwc As Long Dim kw(3) As String Dim r1 As Long, r2 As Long Dim txt As String, exists As Boolean 'アクティブなシートを結果表示シートとする Set st1 = ActiveSheet '結果表示シートのA1:A3からキーワードを取得する For i = 1 To 4 If st1.Range("A" & i).Value <> "" Then kw(kwc) = st1.Range("A" & i).Value kwc = kwc + 1 End If Next i 'キーワードが入力されていなかったらマクロを終了する If kwc = 0 Then MsgBox "キーワードが入力されていません。" & vbLf & "抽出を終了します。" Exit Sub End If 'ちらつき防止と高速化のためエクセルの再描画を抑止する Application.ScreenUpdating = False '結果表示シートのA6以降を一旦クリアする r1 = st1.Range("A" & Rows.Count).End(xlUp).Row If r1 >= 6 Then st1.Rows("6:" & r1).ClearContents r1 = 6 '全てのシートについて繰り返す For Each st2 In Worksheets '結果表示シート以外のとき If st2.Name <> st1.Name Then '1行目からE列の最終行まで繰り返す For r2 = 2 To st2.Range("E" & Rows.Count).End(xlUp).Row txt = st2.Range("E" & r2).Value 'E列にキーワードがすべて含まれているか判定する exists = True For i = 0 To kwc - 1 If InStr(txt, kw(i)) = 0 Then exists = False Exit For End If Next i 'キーワードがすべてく踏まれていたらA列からE列を結果表示シートに転記する If exists Then st1.Range("A" & r1).Resize(, 5).Value = st2.Range("A" & r2).Resize(, 5).Value r1 = r1 + 1 End If Next r2 End If Next st2 'エクセルの再描画を再開する Application.ScreenUpdating = True End Sub ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝