【Excel VBA】複数条件でデータを抽出して別シートにまとめる方法（コピペOK）

Excel VBAで複数条件のデータを別シートへ抽出するなら、同じ列の候補はOR、別の列に設定する条件はANDとしてAutoFilterへ渡します。この記事のコードは「カテゴリが原材料または外注費」かつ「日付が今月」の行だけを取り出し、元シートを変更せず、日時付きの新しい結果シートへまとめます。

旧版のように抽出先へCells.Clearを実行する方法は使いません。前回結果や手入力メモを誤って消さないよう、結果は毎回抽出結果_yyyymmdd_HHmmssという新規シートに作成します。条件が0件、入力が不正、処理が中断された場合は結果シートを追加しません。ブックの自動保存もしないため、結果を確認してから自分で保存できます。

実行前後：元データを残して抽出結果を新規シートへ出す

実行前は「データ」シートに一覧表があります。1行目を見出し、2行目以降をデータとして使います。

日付	カテゴリ	品名	金額
2026/04/01	原材料	鋼材A	50000
2026/04/03	消耗品	手袋	6000
2026/04/15	外注費	加工B	30000

実行後は、条件に一致した行だけを持つ新しいシートがブックの末尾に追加されます。画像では固定名の「抽出結果」と表示されていますが、掲載コードでは上書きを避けるため日時付きの名前になります。

確認点	このコードの動作
元データ	値、数式、フィルター、手動の非表示状態を変更しない
抽出条件	カテゴリ列の複数値はOR、日付列とはAND
抽出先	日時付きシートを新規作成し、過去の結果は残す
0件・エラー	新しい結果を追加せず、既存シートも消さない
転記内容	数式は計算結果へ固定し、値と数値表示形式を転記する

安全版コードの前提となる表の形

コードは、次の条件を満たす一覧表を対象にしています。標準モジュールへ貼り付けるブックは、マクロ有効ブック（.xlsm）として保存してください。

• 対象表は「データ」シートのA1セルから始まる
• 1行目に空白のない見出しがあり、「カテゴリ」と「日付」が含まれる
• 2行目以降の値が入っている行では、カテゴリと日付が空白ではない
• 日付列は文字列ではなく、Excelが日付シリアル値として保持する実日付である
• 同じ見出し名を複数列で使わない
• ブック構成と元シートが保護されていない
• 結果シートを追加できる、読み取り専用ではないブックで実行する

最終行や最終列の考え方を変えたい場合は、VBAで最終行・最終列を取得する方法も参考になります。日付に見える文字列を実日付へ直す場合は、VBAの型変換と日付変換を確認してください。セルの表示形式だけを「日付」に変えても、文字列そのものは日付シリアル値には変わりません。

マクロを保存するブックと実行対象を取り違えない

掲載コードのThisWorkbookは、現在画面で選択しているブックではなく、コードを保存しているブックを表します。「データ」シートと標準モジュールを同じ.xlsmファイルに置く前提です。コードを個人用マクロブックや別のツールブックへ移すと、ThisWorkbookが指す先も変わり、対象シートが見つからなくなります。

この区別は安全性にも関係します。ActiveWorkbookだけで元データを決めると、マクロ実行直前に別ブックをクリックしただけで処理対象が変わります。掲載コードは元データ、結果追加、日付システムの確認をすべてThisWorkbookへ限定し、一時ブックだけを明示的な変数tempBookで扱います。

ブック	役割	保存
ThisWorkbook	元データと完成結果を持つ対象ブック	利用者が結果確認後に保存する
tempBook	元シートの複製、フィルター、未完成結果を持つ一時ブック	保存せず閉じる
ほかに開いているブック	処理対象外	このマクロでは変更しない

コードを別ブックから実行する仕組みへ変える場合は、対象Workbookを利用者に選ばせ、選択後にファイル名、シート名、読み取り専用、保護状態をもう一度確認します。単にThisWorkbookをActiveWorkbookへ一括置換すると、一時ブックを作った後に参照先が変わる箇所が生まれるため、安全な変更にはなりません。

マクロのセキュリティ設定は安易に下げない

コードを実行できないときに、Excelのマクロ設定を「すべてのマクロを有効にする」へ恒久的に変更する方法は勧めません。組織のポリシーに従い、信頼できる作業用ファイルかを確認し、必要なら管理者が指定した信頼済み場所、デジタル署名、ファイルのブロック解除など正規の方法を使います。

インターネットやメールから取得したブックには、この記事以外のVBAが含まれる可能性があります。VBEの標準モジュール、ThisWorkbook、各シートモジュールを確認し、内容が分からないイベントマクロを含むファイルで実行しません。掲載コードは実行中だけイベントを無効にしますが、ブックに含まれる他のコード自体を安全にする機能ではありません。

最初の試験では、元ファイルを複製し、ネットワーク共有上ではなく組織ルールで許可された作業場所を使います。正常、0件、不正日付の三つを確認してから業務データへ広げます。安全版が既存シートを変更しない設計でも、保存されていない別の編集内容や、ブック内の他マクロまで自動的にバックアップするわけではありません。

複数条件でデータを抽出して別シートへまとめるコード

Alt＋F11でVBEを開き、「挿入」→「標準モジュール」を選び、次のコードを貼り付けます。実行するマクロ名はFilterAndCopySafeV3です。

Option Explicit

Private Const SOURCE_SHEET As String = "データ"
Private Const CATEGORY_HEADER As String = "カテゴリ"
Private Const DATE_HEADER As String = "日付"
Private Const RESULT_PREFIX As String = "抽出結果_"
Private Const PROC_NAME As String = "FilterAndCopySafeV3"
Private Const NO_MATCH As Long = vbObjectError + 7099

Public Sub FilterAndCopySafeV3()

    RunFilterAndCopySafeV3 True

End Sub

Public Sub RunFilterAndCopySafeV3( _
    Optional ByVal showMessages As Boolean = True)

    Dim categories As Variant
    Dim startDate As Date, endDate As Date
    Dim wsSource As Worksheet, wsClone As Worksheet
    Dim wsWork As Worksheet, wsReady As Worksheet, wsOutput As Worksheet
    Dim tempBook As Workbook
    Dim sourceRange As Range, workRange As Range
    Dim bodyRange As Range, visibleRange As Range, oneArea As Range
    Dim foundCell As Range, readyRange As Range
    Dim headers As Object
    Dim values As Variant, valueItem As Variant, headerText As String
    Dim lastRow As Long, lastCol As Long, usedLastCol As Long
    Dim categoryCol As Long, dateCol As Long
    Dim r As Long, c As Long, i As Long
    Dim outputRow As Long, outputCount As Long
    Dim rowHasData As Boolean
    Dim outputName As String
    Dim outputCreated As Boolean, outputCopyStarted As Boolean
    Dim worksheetCountBefore As Long, succeeded As Boolean

    Dim oldScreen As Boolean, oldEvents As Boolean
    Dim oldAlerts As Boolean, oldCalculation As XlCalculation
    Dim oldCancel As XlEnableCancelKey, oldStatus As Variant
    Dim oldBook As Workbook, oldSheet As Object
    Dim stateSaved As Boolean
    Dim errorNumber As Long, errorText As String, cleanupNote As String

    On Error GoTo Failed

    '--- 書き換え箇所
    categories = Array("原材料", "外注費")
    startDate = DateSerial(Year(Date), Month(Date), 1)
    endDate = DateSerial(Year(Date), Month(Date) + 1, 0)
    '--- ここまで

    Set oldBook = ActiveWorkbook
    Set oldSheet = ActiveSheet
    oldScreen = Application.ScreenUpdating
    oldEvents = Application.EnableEvents
    oldAlerts = Application.DisplayAlerts
    oldCalculation = Application.Calculation
    oldCancel = Application.EnableCancelKey
    oldStatus = Application.StatusBar
    stateSaved = True

    If Not IsArray(categories) Then _
        AbortRun "カテゴリ条件はArrayで指定してください。"
    For i = LBound(categories) To UBound(categories)
        If IsError(categories(i)) Then _
            AbortRun "カテゴリ条件にエラー値があります。"
        If Len(Trim$(CStr(categories(i)))) = 0 Then _
            AbortRun "空のカテゴリ条件は指定できません。"
    Next i

    If startDate > endDate Then AbortRun "開始日が終了日より後です。"
    If ThisWorkbook.ProtectStructure Then _
        AbortRun "ブック構成が保護されています。"
    If ThisWorkbook.ReadOnly Then _
        AbortRun "読み取り専用ブックでは実行できません。"

    On Error Resume Next
    Set wsSource = ThisWorkbook.Worksheets(SOURCE_SHEET)
    On Error GoTo Failed
    If wsSource Is Nothing Then _
        AbortRun "元シート「" & SOURCE_SHEET & "」が見つかりません。"

    Set foundCell = wsSource.Rows(1).Find( _
        What:="*", After:=wsSource.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, MatchCase:=False, _
        MatchByte:=False, SearchFormat:=False)
    If foundCell Is Nothing Then AbortRun "1行目にヘッダーがありません。"
    lastCol = foundCell.Column

    Set foundCell = wsSource.Cells.Find( _
        What:="*", After:=wsSource.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, MatchCase:=False, _
        MatchByte:=False, SearchFormat:=False)
    If Not foundCell Is Nothing Then usedLastCol = foundCell.Column
    If usedLastCol > lastCol Then _
        AbortRun "ヘッダーのない列にデータがあります。"

    Set headers = CreateObject("Scripting.Dictionary")
    headers.CompareMode = vbTextCompare

    For c = 1 To lastCol
        valueItem = wsSource.Cells(1, c).Value2
        If IsError(valueItem) Then _
            AbortRun c & "列目のヘッダーがエラー値です。"

        headerText = CStr(valueItem)
        If Len(Trim$(headerText)) = 0 Then _
            AbortRun c & "列目のヘッダーが空白です。"
        If headers.Exists(headerText) Then _
            AbortRun "ヘッダー「" & headerText & "」が重複しています。"
        headers.Add headerText, c
    Next c

    If Not headers.Exists(CATEGORY_HEADER) Then _
        AbortRun "「" & CATEGORY_HEADER & "」列が見つかりません。"
    If Not headers.Exists(DATE_HEADER) Then _
        AbortRun "「" & DATE_HEADER & "」列が見つかりません。"
    categoryCol = CLng(headers(CATEGORY_HEADER))
    dateCol = CLng(headers(DATE_HEADER))

    Set foundCell = wsSource.Range( _
        wsSource.Cells(1, 1), _
        wsSource.Cells(wsSource.Rows.Count, lastCol)).Find( _
        What:="*", After:=wsSource.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, _
        MatchByte:=False, SearchFormat:=False)
    lastRow = 1
    If Not foundCell Is Nothing Then lastRow = foundCell.Row
    If wsSource.AutoFilterMode Then
        r = wsSource.AutoFilter.Range.Row + _
            wsSource.AutoFilter.Range.Rows.Count - 1
        If r > lastRow Then lastRow = r
    End If
    If lastRow < 2 Then AbortRun "データ行がありません。"

    Set sourceRange = wsSource.Range( _
        wsSource.Cells(1, 1), wsSource.Cells(lastRow, lastCol))
    values = sourceRange.Value2

    For r = 2 To UBound(values, 1)
        rowHasData = False
        For c = 1 To UBound(values, 2)
            If HasContent(values(r, c)) Then
                rowHasData = True
                Exit For
            End If
        Next c

        If rowHasData Then
            valueItem = values(r, categoryCol)
            If IsError(valueItem) Or Not HasContent(valueItem) Then _
                AbortRun r & "行目のカテゴリが空白またはエラー値です。"

            valueItem = values(r, dateCol)
            If IsError(valueItem) Or Not HasContent(valueItem) Then _
                AbortRun r & "行目の日付が空白またはエラー値です。"
            If VarType(valueItem) = vbString Or Not IsNumeric(valueItem) Then _
                AbortRun r & "行目の日付が文字列です。実日付へ直してください。"
        End If
    Next r

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableCancelKey = xlErrorHandler
    Application.StatusBar = "一時ブックで抽出しています..."

    Set tempBook = Workbooks.Add(xlWBATWorksheet)
    tempBook.Date1904 = ThisWorkbook.Date1904
    Set wsWork = tempBook.Worksheets(1)
    wsWork.Name = "FilterWork"

    '元がフィルター中でも全行を得るため、シートごと一時側へ複製する。
    wsSource.Copy Before:=wsWork
    Set wsClone = tempBook.Worksheets(1)

    If wsClone.ProtectContents Then _
        AbortRun "元シートが保護されています。"
    If wsClone.FilterMode Then wsClone.ShowAllData
    wsClone.Rows("1:" & CStr(lastRow)).Hidden = False
    wsClone.Range( _
        wsClone.Cells(1, 1), _
        wsClone.Cells(1, lastCol)).EntireColumn.Hidden = False

    wsClone.Range( _
        wsClone.Cells(1, 1), _
        wsClone.Cells(lastRow, lastCol)).Copy
    wsWork.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    wsClone.Delete

    Set workRange = wsWork.Range("A1").Resize(lastRow, lastCol)
    If HasFormula(workRange) Then _
        AbortRun "一時データに数式が残ったため中止します。"

    workRange.AutoFilter Field:=categoryCol, _
        Criteria1:=categories, Operator:=xlFilterValues
    workRange.AutoFilter Field:=dateCol, _
        Criteria1:=">=" & CStr(BookSerial(startDate)), _
        Operator:=xlAnd, _
        Criteria2:="<" & CStr(BookSerial(endDate) + 1)

    outputCount = CLng(Application.WorksheetFunction.Subtotal( _
        103, workRange.Columns(categoryCol))) - 1
    If outputCount <= 0 Then _
        Err.Raise NO_MATCH, PROC_NAME, "条件に一致するデータは0件です。"

    Set bodyRange = workRange.Offset(1, 0).Resize(lastRow - 1, lastCol)
    Set visibleRange = bodyRange.SpecialCells(xlCellTypeVisible)

    Set wsReady = tempBook.Worksheets.Add(After:=wsWork)
    workRange.Rows(1).Copy
    wsReady.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    outputRow = 2

    For Each oneArea In visibleRange.Areas
        oneArea.Copy
        wsReady.Cells(outputRow, 1).PasteSpecial _
            Paste:=xlPasteValuesAndNumberFormats
        outputRow = outputRow + oneArea.Rows.Count
    Next oneArea
    Application.CutCopyMode = False

    Set readyRange = wsReady.Range("A1").Resize(outputCount + 1, lastCol)
    readyRange.Rows(1).Font.Bold = True
    readyRange.AutoFilter
    readyRange.Columns.AutoFit
    If outputRow <> outputCount + 2 Then _
        AbortRun "抽出件数と作成行数が一致しません。"
    If HasFormula(readyRange) Then _
        AbortRun "結果に数式が残ったため中止します。"

    outputName = NewOutputName(ThisWorkbook)
    worksheetCountBefore = ThisWorkbook.Worksheets.Count
    outputCopyStarted = True
    wsReady.Copy After:=ThisWorkbook.Worksheets(worksheetCountBefore)
    Set wsOutput = ThisWorkbook.Worksheets(worksheetCountBefore + 1)
    outputCreated = True
    wsOutput.Name = outputName

    If HasFormula(wsOutput.Range("A1").Resize( _
                  outputCount + 1, lastCol)) Then _
        AbortRun "新規結果に数式が残ったため取り消します。"

    succeeded = True
    GoTo CleanExit

Failed:
    errorNumber = Err.Number
    errorText = Err.Description

CleanExit:
    On Error Resume Next
    Application.CutCopyMode = False

    If Not succeeded Then
        Err.Clear
        If outputCreated Then
            wsOutput.Delete
        ElseIf outputCopyStarted And _
               ThisWorkbook.Worksheets.Count > worksheetCountBefore Then
            ThisWorkbook.Worksheets(worksheetCountBefore + 1).Delete
        End If
        If Err.Number <> 0 Then _
            cleanupNote = vbCrLf & "注意: 未完成シートを削除できませんでした。"
    End If

    If Not tempBook Is Nothing Then tempBook.Close SaveChanges:=False
    If Not oldBook Is Nothing Then oldBook.Activate
    If Not oldSheet Is Nothing Then oldSheet.Activate

    If stateSaved Then
        Application.StatusBar = oldStatus
        Application.EnableCancelKey = oldCancel
        Application.Calculation = oldCalculation
        Application.DisplayAlerts = oldAlerts
        Application.EnableEvents = oldEvents
        Application.ScreenUpdating = oldScreen
    End If
    On Error GoTo 0

    If showMessages Then
        If succeeded Then
            MsgBox outputCount & "件を抽出しました。" & vbCrLf & _
                   "新規シート: " & outputName & vbCrLf & _
                   "元シートと既存結果は変更していません。", _
                   vbInformation, "抽出完了"
        ElseIf errorNumber = NO_MATCH Then
            MsgBox "条件に一致するデータは0件です。" & vbCrLf & _
                   "結果シートは追加していません。", _
                   vbInformation, "抽出結果"
        ElseIf errorNumber = 18 Then
            MsgBox "処理を中止しました。既存シートは変更していません。" & _
                   cleanupNote, vbExclamation, "抽出中止"
        Else
            MsgBox "抽出できませんでした。" & vbCrLf & _
                   errorText & vbCrLf & _
                   "既存シートは変更していません。" & cleanupNote, _
                   vbCritical, "抽出失敗"
        End If
    End If

End Sub

Private Sub AbortRun(ByVal message As String)

    Err.Raise vbObjectError + 7000, PROC_NAME, message

End Sub

Private Function HasContent(ByVal valueItem As Variant) As Boolean

    If IsError(valueItem) Then
        HasContent = True
    ElseIf IsEmpty(valueItem) Then
        HasContent = False
    ElseIf VarType(valueItem) = vbString Then
        HasContent = (Len(Trim$(CStr(valueItem))) > 0)
    Else
        HasContent = True
    End If

End Function

Private Function BookSerial(ByVal targetDate As Date) As Long

    BookSerial = CLng(DateValue(targetDate))
    If ThisWorkbook.Date1904 Then BookSerial = BookSerial - 1462

End Function

Private Function HasFormula(ByVal targetRange As Range) As Boolean

    Dim formulaCells As Range

    On Error Resume Next
    Set formulaCells = targetRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    HasFormula = Not formulaCells Is Nothing

End Function

Private Function NewOutputName(ByVal book As Workbook) As String

    Dim baseName As String, candidate As String, suffix As String
    Dim sequence As Long

    baseName = Left$(RESULT_PREFIX & Format$(Now, "yyyymmdd_HHmmss"), 31)
    candidate = baseName
    sequence = 2

    Do While SheetExists(book, candidate)
        suffix = "_" & CStr(sequence)
        candidate = Left$(baseName, 31 - Len(suffix)) & suffix
        sequence = sequence + 1
    Loop

    NewOutputName = candidate

End Function

Private Function SheetExists( _
    ByVal book As Workbook, ByVal sheetName As String) As Boolean

    Dim targetSheet As Object

    On Error Resume Next
    Set targetSheet = book.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not targetSheet Is Nothing

End Function

処理は元シートそのものへAutoFilterを設定しません。元シートを一時ブックへ複製し、その複製だけを再表示してから条件を設定します。このため、実行前に元シートへ別のフィルターが設定されていても、元の矢印、絞り込み条件、非表示行はそのままです。

元シートが絞り込み中だと、Findだけでは末尾の非表示行を見落とす場合があります。掲載コードはFind結果と既存AutoFilter範囲の最下行を比べ、大きい方を作業範囲の末尾に採用します。これにより、元フィルターで隠れていた月末行も一時側へ含めます。

コードが安全に抽出するまでの処理を順に読む

掲載コードは長く見えますが、複雑な集計をしているわけではありません。長さの大部分は、元データへ触れないこと、0件を通常の結果として扱うこと、途中失敗で未完成シートを残さないこと、Excelの設定を元に戻すことに使っています。どこを変更してよいか判断できるよう、処理を入口から順番に確認します。

1. 実行条件をコードの先頭で確定する

categories、startDate、endDateは、データへ触る前に確定します。配列では空の候補やエラー値を拒否し、開始日が終了日より後なら中止します。条件が正しいか不明なまま結果シートを作り始めないためです。条件をセルから読む形へ変える場合も、この検証より前に読み込み、同じ順序で内容を確かめます。

2. Excelの設定を保存してから高速化設定へ切り替える

画面更新、イベント、警告表示、自動計算、EscやCtrl＋Breakの扱い、ステータスバーは、利用者のExcel環境によって開始時の状態が異なります。安全版は現在値を変数へ保存してから処理用の設定へ切り替えます。終了時に単純にTrueや自動計算へ決め打ちするのではなく、保存した値へ戻すため、実行前に手動計算だったブックを勝手に自動計算へ変えません。

EnableEventsを一時的に無効にするのは、新規シート追加をきっかけにWorkbookやWorksheetのイベントマクロが割り込むのを避けるためです。イベントを無効のまま残すと他の自動処理が動かなくなるので、成功、0件、エラー、中断のすべてが同じ後始末へ進む構造にしています。

3. シート名とブック状態を先に検証する

元シートが見つからない、ブック構成が保護されている、読み取り専用である、といった条件は、抽出ロジックを始める前に判定します。読み取り専用でも画面上は一時的にシートを追加できる場合がありますが、保存できない結果を作って利用者を迷わせないため、このコードは実行対象から外します。

元シート名はThisWorkbookを基準に探します。ActiveWorkbookを基準にすると、別ブックをクリックした直後や、一時ブックがアクティブになった後に対象を取り違える可能性があります。マクロを保存したブックとデータブックを分ける構成へ変更するなら、どのWorkbookを処理対象とするかを明示的に設計し直してください。

4. 見出しから相対列を求める

カテゴリ列や日付列を「B列」「A列」のような固定番号だけで指定すると、利用者が列を1本追加したときに別の列へ条件をかける危険があります。コードは1行目を読み、見出し名と列位置をDictionaryへ登録します。空の見出し、エラー値の見出し、重複見出しは、どの列を使うか一意に決められないため中止します。

見出し文字列はセルの内容と定数を比較します。見た目が似ていても、末尾空白や改行が含まれれば別の文字列です。見出しを自動でTrimして進めると、表の不備が残ったままになるため、安全版は表側または定数側の名称を明示的にそろえる前提です。

5. 値のある行だけカテゴリと日付を検証する

一覧表の途中に完全な空行があっても、他のデータ行が正しければ処理できます。ただし、何か1つでも値が入っている行では、カテゴリと日付を必須とします。カテゴリが空の行はOR条件の意味が決まらず、日付が空または文字列の行は期間比較が正しくできないためです。

「2026/08/01」と表示されていても、Value2が文字列なら中止します。AutoFilterが地域設定や入力経路によって文字列日付を日付のように扱う場合へ依存しないためです。実日付へ直してから再実行すれば、開始日、終了日、時刻付きの境界を同じ数値基準で比較できます。

6. 元範囲ではなく、複製したシートを再表示する

フィルター中のRangeをそのままCopyすると、Excelの状態によって可視行だけが詰めてコピーされることがあります。その状態で別条件を設定すると、元フィルターで隠れていた対象行を最初から失います。そこで安全版は、範囲ではなくワークシート全体を一時ブックへ複製します。

一時側の複製シートに対してだけShowAllDataとHidden解除を実行します。元シートには同じ命令を実行しません。複製側で全行を見える状態にしてから、対象範囲を値と数値表示形式として作業シートへ貼り付けます。複製シートはその直後に削除し、一時ブックも保存しません。

この順序は、元画面の表示行だけを対象にしたい処理とは異なります。この記事の仕様は「元の表示状態に関係なく、一覧表の全データへ今回の条件を適用する」です。現在見えている行だけを抽出したい場合は要件が別なので、Hidden解除を単純に削るのではなく、フィルター条件を引き継ぐか、可視行だけを明示的に処理する設計へ変更します。

7. 数式を値にした作業範囲へAutoFilterを設定する

一時作業シートへの貼り付けは値と数値表示形式だけです。元表に数式があれば、抽出時点の計算結果へ固定されます。その後、作業範囲にカテゴリ条件と日付条件を順番に設定します。元表の数式再計算や外部リンク更新が、結果を開いた後に内容を変えることを避けられます。

日付条件はブックの日付システムに合わせた整数シリアル値で渡します。画面表示用のyyyy/mm/dd文字列を条件へ連結すると、WindowsやExcelの地域設定によって解釈が変わる余地があります。数値シリアルと「終了翌日未満」を組み合わせることで、時刻を含む月末日も同じルールで扱います。

8. 件数を確定してから可視範囲を取得する

フィルター後は、カテゴリ列の非空セルをSubtotalで数え、見出し1件を差し引きます。0件ならSpecialCellsを呼ばず、専用の結果として後始末へ進みます。0件と予期しないSpecialCellsエラーを同じOn Error Resume Nextで隠さないことが重要です。

一致行がある場合は、データ本体だけを可視範囲として取得します。見出しを含む範囲全体から可視セルを取ると、データが0件でも見出しだけが取得でき、「1件ある」と誤認しやすくなります。コードでは見出し行とデータ本体を分け、見出しは1回だけ結果へ貼り付けます。

9. 一時結果を完成させてから元ブックへ追加する

可視範囲は連続しているとは限らず、複数のAreasに分かれます。各Areaを順に貼り、次の開始行を進めます。貼り付け後の行数が事前に数えた件数と一致しなければ、元ブックへは追加しません。数式セルが残っていないことも一時結果で確認します。

結果シートへ見出しの太字、フィルター矢印、列幅調整を設定するのも一時側です。見た目を整える途中でエラーになっても、元ブックには未完成シートがありません。完成後のワークシートを1枚単位でコピーする段階になって初めて、元ブックのシート数が増えます。

10. コピー開始後の失敗もこの実行分だけ戻す

Worksheet.Copyは、シート追加とオブジェクト取得が完全に同時ではありません。追加直後に中断されると、新しいシートは存在するのにwsOutputへ参照を代入できていないことがあります。そこでコピー開始前のワークシート数と、コピー開始フラグを保存します。

失敗時に出力参照があればそのシートを削除し、参照がなくてもシート数が1枚増えていれば、コピー前の枚数の次にできたシートだけを削除します。名前が「抽出結果」で始まる全シートを探して消す方法は使いません。過去の正常な結果や、利用者が作った同名系統のシートを巻き込まないためです。

このコードが意図的に行わない処理

行わない処理	理由	必要な場合の考え方
元シートのAutoFilter解除	既存の表示条件を変えない	表示変更が目的なら別マクロとして明示する
固定結果シートの全消去	前回結果や手入力を失わない	新結果を確認後に古い結果を整理する
ブックの自動保存	誤条件の結果を確定しない	確認工程を追加してから保存処理を設計する
文字列日付の自動変換	曖昧な日付解釈を避ける	変換専用工程で失敗行を確認する
数式のまま転記	外部参照や再計算で結果を変えない	数式が必要なら参照先と更新責任を決める
塗りや罫線の完全複製	業務データの値を独立させる	必要な装飾だけ結果作成後に明示する
結果0件の空シート作成	空結果を正常結果と誤認しない	ログが必要なら別の管理表へ0件を記録する
古い結果の自動削除	保管期限をコードだけで決めない	組織の保存ルールに沿う整理処理を分ける

処理を追加するときは、「入力検証」「一時側での作成」「元ブックへの反映」「反映後の保存」を分けて考えます。とくに、メール送信、CSV保存、共有フォルダへの出力を抽出と同じマクロへ追加すると、どこまで成功したか分かりにくくなります。まず抽出結果を新規シートとして確定し、その結果を引数または明示的なシート参照で後工程へ渡すほうが、再実行と復旧を管理しやすくなります。

表の種類とデータ量に関する注意

掲載コードは、A1から始まる通常のセル範囲を対象にしています。Excelテーブル（ListObject）を含むシートもワークシート複製の対象になりますが、テーブル固有の集計行、構造化参照、複数テーブルをまたぐ配置を一般化したコードではありません。1シートに複数の独立表がある場合は、A1からどこまでを対象にするかを先に決めます。

結合セルを含む一覧表は、AutoFilterやPasteSpecialの範囲処理と相性がよくありません。見出しまたはデータ行に結合セルがある場合は、結合を解除し、各行が同じ列構造を持つ正規化された一覧へ直してから使います。見た目の帳票と抽出元一覧を同じシートで兼用せず、抽出元は1行1レコードの形にすると条件判定が明確です。

データ量が増えると、ワークシート全体の複製、値と数値表示形式の貼り付け、列幅の自動調整に必要な時間とメモリも増えます。この記事では特定の行数や処理秒数を保証しません。実際の列数、数式、書式、PC環境で試し、処理中に他のブックを操作しない運用にします。列幅調整が不要で処理時間が問題になる場合は、正しい結果を確認した後でreadyRange.Columns.AutoFitを外す選択肢があります。

数十万行に近い一覧、複数の外部リンク、画像や図形が多いシートでは、シート複製方式の負荷が大きくなる場合があります。その場合も、元フィルターを壊す短いコードへ戻すのではなく、配列で全値を読み込む方式、ADOやPower Query、データベース側の抽出などを比較します。扱う量と更新頻度によって適した方法は変わります。

空行を含む表では、最終行までの範囲に空行があっても、フィルター条件に一致しないため結果へ入りません。ただし、見出しのない列にデータがある、表の右側へメモが置かれている、最下部に別表がある、といった配置は対象範囲を曖昧にします。安全版は見出しのない列にデータがあれば中止するので、元表と補足情報を別シートへ分けてから実行します。

AutoFilter、行ループ、Power Queryの使い分け

方法	向いている処理	注意点
AutoFilter（この記事）	列ごとの定型条件で行を抽出し、同じ列構造で結果を作る	複雑な括弧付き条件や行ごとの加工には補助列が必要になる
VBAの行ループ	1行ずつ異なる判定や加工を行い、列を組み替える	元行の削除を伴う場合は後ろから処理するなど順序管理が必要
Power Query	複数ファイルや外部データを同じ手順で取り込み、更新する	出力を手作業で編集する運用とは分けて考える
FILTER関数	Microsoft 365上で条件をセルから変え、結果を動的表示する	元データ変更に連動して結果も変わり、固定スナップショットではない

この記事のAutoFilter方式を選ぶ基準は、処理が「一覧の全列を保ったまま、決まった条件で行を選び、実行時点の値を新規シートへ固定する」ことです。抽出と同時に列を追加する、行ごとに別ファイルへ振り分ける、条件に合う元行を削除するといった要件は、同じコードへ無理に詰め込まず行ループ方式を比較します。

毎回外部CSVを取り込み、型変換、結合、抽出まで同じ手順を繰り返すならPower Queryが管理しやすい場合があります。一方、既に開いている業務ブックの表を対象に、ボタン実行時の結果を独立した値として残す用途ではVBAの新規シート作成が分かりやすい選択です。ツール名から決めず、結果が固定か動的か、元データを変更するか、利用者が条件をどこで管理するかで選びます。

最初に変更する設定は6か所

設定	意味	掲載値
SOURCE_SHEET	元データのシート名	データ
CATEGORY_HEADER	複数候補を指定する列の見出し	カテゴリ
DATE_HEADER	期間を指定する列の見出し	日付
RESULT_PREFIX	結果シート名の先頭	抽出結果_
categories	OR条件で抽出するカテゴリ	原材料、外注費
startDate / endDate	抽出期間の開始日と終了日	今月1日～今月末日

たとえば、シート名が「売上一覧」、見出しが「部門」と「売上日」、候補が「営業一課」と「営業二課」なら、定数と配列をその名称へ変更します。列番号は固定していないため、見出しの順番が変わっても、見出し名が一致すれば対象列を探せます。

カテゴリを1種類だけにする場合も配列のままArray("原材料")とします。カテゴリは完全一致です。「原材料」と「原材料 」のような末尾空白や、全角・半角の違いは別の値として扱われます。表記揺れを直してから実行すると、意図した件数を得やすくなります。

AutoFilterの複数条件：同じ列はOR、別の列はAND

AutoFilterのFieldは、ワークシート全体の列番号ではなく、フィルター対象範囲の左端を1とした相対位置です。掲載コードは見出し名から相対列を求めるため、「カテゴリがB列かC列か」を利用者が数え直す必要はありません。AutoFilterの基本だけを先に確認したい場合は、VBAでAutoFilterを使う方法を参照してください。

カテゴリ条件ではCriteria1:=categoriesとOperator:=xlFilterValuesを組み合わせます。これにより「原材料または外注費」というOR条件になります。その後、日付列にもAutoFilterを設定するため、列どうしはANDで結ばれます。最終的な意味は次のとおりです。

• カテゴリ = 原材料 OR 外注費
• AND 日付 >= 開始日
• AND 日付 < 終了日の翌日

終了条件を「終了日以下」ではなく「終了日の翌日未満」にしているのは、月末日の12:30など時刻を含む値も対象にするためです。<= 月末日を日付の午前0時として比較すると、同じ月末日の午後が外れる場合があります。翌日未満なら、終了日の0:00から23:59:59までを含められます。

掲載コードはブックのDate1904設定も一時ブックへ引き継ぎます。1900日付システムと1904日付システムで基準が異なるため、AutoFilterへ渡すシリアル値も補正しています。

一時ブックで抽出してから新規シートを追加する理由

元シート上でフィルターを解除し、抽出し、最後に元へ戻す方法は短く書けます。しかし、途中でエラーやEscによる中断が起きると、元のフィルター状態を完全に戻せないことがあります。さらに、固定名の結果シートを最初に全消去すると、後続処理が失敗した時点で前回結果も失われます。

安全版は処理を次の順序に分けます。

1. シート名、見出し、日付、ブック状態を検証する
2. 元シートを閉じない一時ブックへ複製する
3. 一時側だけで既存フィルターと非表示を解除する
4. 値と数値表示形式だけの作業用データを作る
5. 作業用データへ新しい抽出条件を設定する
6. 一致行を一時結果シートへまとめ、件数と数式の有無を確認する
7. すべて成功してから、完成した結果を元ブックへ新規追加する

この順序なら、失敗前に既存結果を消す必要がありません。結果シートのコピー中に失敗した場合も、この実行で増えたシートだけを削除します。既存シートの名前や内容を削除対象にしないことが重要です。より一般的な転記方法は、VBAでセルをコピー・転記する方法でも整理しています。

SpecialCellsで可視行を取り出し、0件を先に判定する

AutoFilter後の表示行はSpecialCells(xlCellTypeVisible)で取得できます。ただし、一致するデータ行がない状態で可視データを取得すると実行時エラーになります。そこでコードは、まずSubtotal(103, ...)で表示されているカテゴリ数を数えます。ヘッダー分を差し引いた件数が0以下なら、SpecialCellsを呼ばずに処理を終了します。

可視範囲が複数のAreasに分かれる場合は、各範囲を順に結果へ詰めます。元データの並び順は変えません。出力列も元表の1列目から最終見出し列までを同じ順番で出します。

0件は異常なデータではありません。条件を満たす行がなかったという結果なので、既存シートを消したり、見出しだけの結果を残したりせず、メッセージで知らせます。0件時の例外だけを広いOn Error Resume Nextで隠さないため、別の原因でSpecialCellsが失敗した場合は通常のエラー処理へ進みます。

数式・日付・先頭ゼロはどう転記されるか

作業用データと最終結果にはxlPasteValuesAndNumberFormatsを使います。数式そのものではなく計算結果を値として固定し、日付、通貨、桁区切り、パーセントなどの数値表示形式を維持します。結果が元ブックの数式や外部リンクへ依存しないため、抽出時点のスナップショットとして扱えます。

元セル	結果
数式	計算済みの値。数式は残らない
実日付	日付シリアル値と表示形式を維持
金額・パーセント	値と数値表示形式を維持
文字列の「00123」	文字列として保持
文字列の「=A1」	数式へ変えず文字列として保持
塗り、罫線、入力規則、コメント	結果へは転記しない

xlPasteAllへ変更すると、数式、外部リンク、入力規則なども一緒に持ち込むため、この用途では使いません。見た目を完全に複製することより、抽出結果を独立した値として安全に渡すことを優先しています。

実行できないときに確認する項目

「日付が文字列です」と表示される

日付列の値が「2026/08/01」という文字列で、Excelの日付シリアル値ではありません。セルの表示形式を変えるだけでは直らないため、区切り位置、DATEVALUE、または適切な型変換で実日付へ変換します。変換前に元データのコピーを取ってください。

「カテゴリ列または日付列が見つかりません」と表示される

1行目の見出しと、コード上のCATEGORY_HEADER、DATE_HEADERが一致しているか確認します。前後空白、改行、全角・半角の違いにも注意します。A1から見出しが連続していない表は、空白見出しを補うか、対象範囲の設計を見直してください。

ブックまたはシートの保護で止まる

安全版は一時シートのフィルター解除と、元ブックへの新規結果追加を行います。ブック構成または元シートが保護されている場合は、パスワードをコードへ埋め込まず、権限のある人が保護を解除した作業用コピーで実行します。

エラー後にExcelの画面更新や自動計算が変わった

コードは開始時のScreenUpdating、EnableEvents、DisplayAlerts、Calculation、EnableCancelKey、ステータスバーを保存し、成功・失敗のどちらでも復元します。独自処理を追加する場合も、エラー処理を飛び越えて終了せず、共通の後始末へ流してください。エラー処理の基本はVBAのエラーハンドリングで確認できます。

業務データで使う前に確認するテスト項目

掲載コードは既存シートを上書きしない設計ですが、最初から本番ブックだけで試すのではなく、作業用コピーで条件と件数を確認してください。抽出マクロの正しさは「エラーが出ないこと」だけでは判断できません。境界日、対象外カテゴリ、フィルターで隠れていた行、文字列日付を含む小さな表を用意し、期待する行だけが出るかを確認します。

試験データ	確認すること	期待結果
開始日の0:00、対象カテゴリ	下限を含むか	抽出される
開始日の前日23:59、対象カテゴリ	開始日前を除外するか	抽出されない
終了日の15:00、対象カテゴリ	月末の時刻を含むか	抽出される
終了日の翌日0:00、対象カテゴリ	上限の外を除外するか	抽出されない
期間内、対象外カテゴリ	別列ANDが効くか	抽出されない
期間内、「00123」という文字列	先頭ゼロを保つか	00123のまま
期間内、数式で計算した金額	数式を値化するか	計算結果だけが入る
元フィルターで非表示の対象行	全行へ新条件をかけるか	抽出される
期間内の対象が0件	空結果の扱い	結果シートを増やさない
文字列として入力した日付	不正な比較を防ぐか	メッセージを出して中止

通常ケースだけでなく、0件と不正入力を含めるのがポイントです。0件時に固定の結果シートが消えないこと、エラー後も元のフィルターと手動非表示が変わっていないことも確認します。元データの数式、セル値、シート数を実行前後で比べれば、意図しない変更を見つけやすくなります。

抽出件数は、同じ条件をExcelの画面から手動で設定した件数とも照合できます。ただし、元画面に別のフィルターが残っている場合は一度作業用コピーで全件表示し、掲載コードと同じ条件だけを設定して比べます。元画面の現在表示されている行数と直接比べると、元フィルターの条件まで混ざるため一致しないことがあります。

抽出条件を追加するときに崩してはいけない順序

条件を増やす場合も、元シートへ直接AutoFilterを追加しません。条件は一時側のworkRangeへ設定し、件数確認より前にすべて積み重ねます。たとえば金額見出しの列へ10000以上を追加するなら、見出し名から相対列を求めたうえで、カテゴリと日付のAutoFilterに続けて指定します。

文字列条件には、完全一致、部分一致、空白という別の考え方があります。掲載コードのカテゴリ配列は完全一致です。部分一致へ変える場合は、単純に配列へアスタリスクを入れるだけでは、複数候補指定との組み合わせや、セル内のアスタリスクそのものを探す場合のエスケープが変わります。業務要件が完全一致なら、ワイルドカードを追加しないほうが誤抽出を防げます。

条件の種類	設計時の確認点
文字列の完全一致	前後空白、改行、全角・半角、表記揺れを事前にそろえる
文字列の部分一致	ワイルドカードで余計な値まで一致しないか試験する
数値の範囲	数値に見える文字列と数値セルを混在させない
日付の範囲	実日付か、時刻を含むか、開始・終了を含めるかを決める
空白・空白以外	数式が返す空文字を空白として扱うか決める
複数列	列どうしはANDになるため、条件を増やすほど件数が減ることを確認する

条件をセルから読む運用へ変える場合は、空欄、エラー値、開始日と終了日の逆転をマクロ実行前に検証します。VBEを開けない利用者でも条件を変えられる利点はありますが、入力セルの位置を移動されたり、日付を文字列で入力されたりする可能性も増えます。「セルから読めた」ことと「安全な条件である」ことを別々に確認してください。

結果シートを履歴として残すときの運用

日時付きの結果名は、前回結果を残しながら再実行するためのものです。同じ秒に実行して同名になる場合は、末尾に連番を付けて新しい名前を作ります。既存の「抽出結果_…」シートを検索して全削除する処理は入れていません。削除期限や保管件数は、データの管理ルールを確認して利用者が判断します。

結果を履歴として残す場合は、シート名だけで条件を推測しない運用にします。カテゴリ候補、開始日、終了日、実行者などを別の管理表へ記録するか、結果を渡すときに条件を併記します。同じ「今月分」でも、実行日や元データ更新時刻が違えば内容が変わる可能性があるためです。

一方、常に最新結果だけが必要でも、マクロの冒頭で前回結果を削除しないほうが安全です。新しい結果を作って件数と内容を確認し、問題がなければ古い結果を手動または別の明示的な整理処理で削除します。「古い結果の削除」と「新しい結果の作成」を分ければ、抽出途中の失敗で両方を失うことがありません。

抽出後にブックを保存する前には、少なくとも結果行数、期間の端の日付、対象カテゴリ、先頭ゼロ、金額表示を確認します。CSVへ出す場合は、CSVにはセルの表示形式がそのまま保存されない点にも注意します。Excel上で「00123」と見えていても、値が数値123なら出力側の仕様によって先頭ゼロが消えます。掲載コードは元が文字列の「00123」を文字列のまま扱う設計です。

失敗した場所ごとの結果と復旧方法

安全版は、どの段階で止まったかによって後始末を変えます。元シートの検証中、一時ブックでの抽出中、元ブックへのコピー中を区別し、まだ作っていないシートを削除しようとしたり、既存結果を復旧対象にしたりしません。

停止した段階	元シート	結果シート	利用者の対応
条件配列・日付の検証	変更なし	追加なし	条件を直して再実行
見出し・データ行の検証	変更なし	追加なし	表示された行や見出しを修正
元シート保護の検出	保護状態のまま	追加なし	権限のある作業用コピーを用意
一時ブックで0件	変更なし	追加なし	カテゴリと期間が正しいか確認
一時結果の件数不一致	変更なし	追加なし	結合セルや表構造を見直す
元ブックへのコピー前	変更なし	追加なし	エラーメッセージを確認
コピー直後・名前設定前	変更なし	増えた未完成シートだけ削除	シート名やブック状態を確認
完成後	変更なし	新規結果を保持	内容確認後に保存

エラーメッセージが出た後に未完成らしいシートが残った場合は、すぐに再実行せず、元データと既存結果が無事かを先に確認します。削除処理自体が、シート保護や別のExcelエラーで失敗した可能性があります。メッセージに「未完成シートを削除できませんでした」とある場合は、実行時刻に近い名前のシートを開き、内容を確認してから手動で整理します。

Excelが応答しなくなった場合も、同じマクロを重ねて起動しません。処理対象の行数やシート上の図形、外部リンクなどにより、一時シートの複製に時間がかかっている可能性があります。タスク終了を行う前に保存されていない他ブックがないか確認し、再起動後は作業用コピーで小さな範囲から原因を切り分けます。

条件を追加した後のレビュー観点

第三、第四の条件を追加したら、コードが動くかだけでなく、条件の意味が読み手に伝わるかを確認します。列ごとの条件を日本語で1行にし、期待件数と一緒にレビューすると、ORとANDの取り違えを見つけやすくなります。

レビュー項目	確認内容
対象母集団	元フィルターに関係なく全行を対象にする仕様でよいか
カテゴリ候補	候補どうしがORで、完全一致でよいか
別列条件	カテゴリ・日付とANDで結ぶのが要件どおりか
日付下限	開始日の0:00を含めるか
日付上限	終了日の時刻をすべて含めるか
空白値	空白カテゴリや空白日付をエラーにするか
出力列	元表の全列を同じ順序で出すか
数式	結果を値へ固定する仕様でよいか
履歴	結果を毎回新規作成し、保存期限を誰が管理するか
0件	シートを作らずメッセージだけにするか

たとえば「カテゴリがAまたはB、かつ、期間内、かつ、金額が1万円以上」という要件なら、AとBの間だけがORです。「カテゴリA、または、カテゴリBかつ期間内」のように優先順位が異なる要件は、AutoFilterを列ごとに積み重ねるだけでは表現が変わります。条件式を括弧付きで書き出し、必要なら補助列を作って判定結果をフィルターする方法を検討します。

金額や数量の条件を追加するときは、対象列が数値で統一されているかを確認します。見た目が同じでも、数値10000と文字列「10000」が混在すると、比較条件の結果が揃わないことがあります。抽出マクロ側で何でも自動変換すると元データの不備が見えなくなるため、入力・取込工程で型をそろえるほうが再利用しやすいデータになります。

結果を保存する前の確認手順

1. 完了メッセージの件数と、結果シートのデータ行数が一致するか確認する
2. 最初と最後の日付を並べ替えずに見て、対象期間の外がないか確認する
3. カテゴリ列のフィルター候補を開き、指定外の表記が混ざっていないか確認する
4. 数式バーで代表セルを見て、数式ではなく値になっているか確認する
5. コードや社員番号などの先頭ゼロが必要な列を確認する
6. 日付、通貨、パーセントの表示形式が引き継がれているか確認する
7. 元シートへ戻り、実行前のフィルター条件と非表示行が維持されているか確認する
8. 問題がなければブックを保存し、不要な古い結果は保存ルールに従って整理する

この確認は、マクロへの信頼性が低いから行うのではなく、抽出条件と元データが業務上正しいかを確定する工程です。コードが同じでも、表記揺れ、取込日、更新漏れによって結果は変わります。条件、入力、出力の三つを分けて確認すると、どこを修正すべきか判断できます。

よくある質問：複数条件の追加、0件、既存フィルター

別の列へ条件を追加すると、ANDになりますか？

はい。同じAutoFilter範囲へ列を変えて条件を設定すると、別列どうしはANDになります。同じカテゴリ列で複数候補を配列指定した部分だけがORです。たとえばカテゴリ条件に加えて金額列へ「10000以上」を設定すれば、「指定カテゴリのどれか、かつ、指定期間内、かつ、金額10000以上」になります。

カテゴリを1種類だけ抽出するには？

categories = Array("原材料")とします。1要素でも配列にしておけば、将来2種類へ増やすときにAutoFilterの書き方を変えずに済みます。空文字の要素は条件として認めないため、空白だけを抽出したい用途にはこのコードをそのまま使いません。

今月ではなく任意の期間へ変更するには？

startDateとendDateをDateSerialで指定します。2026年7月10日から8月5日なら、開始日をDateSerial(2026, 7, 10)、終了日をDateSerial(2026, 8, 5)とします。開始日が終了日より後の場合は実行を中止します。

月末日に時刻が入っていても抽出されますか？

はい。終了日の翌日未満で比較するため、終了日の午後を含みます。文字列の「2026/08/31 15:00」は対象外で、Excelが数値として保持する日付時刻である必要があります。

既存のフィルターや手動の非表示行はどうなりますか？

元シートは変更しません。フィルター解除と行・列の再表示は一時ブックへ複製したシートだけで行います。そのため、元シートの表示状態は実行前のままです。一方、抽出対象は元画面で見えている行だけではなく、複製側で再表示した全データ行です。元フィルターに隠れていた行も、新しい条件に一致すれば結果へ入ります。

0件またはエラーのとき、前回結果は消えますか？

消えません。固定名の結果シートをクリアせず、すべての検証と一時結果の作成が成功した後にだけ新規シートを追加します。追加途中に失敗した場合は、この実行で増えた未完成シートだけを削除します。

結果シートは自動保存されますか？

自動保存しません。抽出件数、日付、先頭ゼロ、金額表示を確認し、問題がなければ通常どおりブックを保存します。誤った条件で実行しても、保存前なら結果シートを閉じるか削除してやり直せます。

行ごとに加工しながらコピーしたい場合は？

AutoFilterは定型条件で行をまとめて取り出す用途に向いています。行ごとに列を組み替える、判定結果を書き足す、条件に合う元行を移動するといった処理は、条件に合う行を別シートへコピー・移動する方法のようなループ方式が適しています。

抽出後に重複削除やCSV出力へ進む

抽出結果は値として独立した新規シートなので、後工程へ渡しやすい形です。納品前に同じキーの行を整理するなら、VBAで重複データを削除する方法を使います。外部システムへ受け渡すなら、列順と文字コードを確認してからVBAでCSVを書き出す方法へ進みます。

この抽出処理で大切なのは、短いコードにすることよりも、元データと前回結果を壊さない順序です。元シートを一時側へ複製し、条件・件数・転記結果を確認してから新しい結果を追加する流れにすると、0件や途中エラーでも既存データを残したままやり直せます。