【VBA】全てのシートを部分一致で抽出する方法

日々の業務では大量のデータの中から特定の情報を素早く取り出すことが求められます。しかし手作業で探すのは時間がかかります。この記事では、部分一致で指定した文字列を持つ行だけを全シートから一括で抽出するVBAマクロを作成します。

サンプルコード

VBA

Option Explicit
Sub ExtractPartialMatchRows()
    Dim ws As Worksheet, lastRow As Long, i As Long, searchStr As String
    Application.ScreenUpdating = False '画面更新停止
    searchStr = InputBox("抽出する文字列を入力してください")
    If searchStr <> "" Then
        For Each ws In ThisWorkbook.Worksheets
            With ws
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row '最終行取得
                For i = lastRow To 2 Step -1 '逆順でループ
                    If InStr(1, .Cells(i, 1), searchStr) > 0 Then '部分一致検索
                        .Rows(i).Copy Destination:=ThisWorkbook.Sheets("抽出結果").Cells(Rows.Count, 1).End(xlUp).Offset(1)
                    End If
                Next i
            End With
        Next ws
    End If
    Application.ScreenUpdating = True '画面更新再開
End Sub

よくある質問

Q 元に戻せますか？

VBAの実行結果は「元に戻す」が効きません。必ずバックアップを取ってから実行してください。

Q エラーが出たら？

シート名や列番号が正しいか確認してください。