🔄
CopyRowsIfCondition
データ処理A列の値が指定したキーワードに一致する行を新しいシートにコピーします
特定の列の値が指定した条件（キーワードや数値）に一致する行だけを自動的に抽出し、新しいシートにコピーするマクロです。Excelの標準フィルター機能と違い、抽出結果が別シートに保存されるため、元データを保持しながら絞り込み結果を独立した資料として活用できます。対象列・検索値をダイアログで指定するだけで、大量データからの条件抽出が即座に完了します。データ分析や報告書作成の前処理として活躍します。抽出はループで各行を判定してコピーする素直な作りなので、条件を「完全一致のみ」「数値の大小比較」などに変えるカスタマイズも容易です。フィルターで表示を絞る方法と違い、抽出結果が独立したシートになるため、そのまま別ファイルとして保存したり、関係者に共有したりできます。定例の抽出作業であれば、キーワードをコードに固定してワンクリック運用にするのもおすすめです。
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： CopyRowsIfCondition を実行し、検索キーワードを入力します
🎯 活用シーン
- ✓売上データから特定の担当者やエリアのデータだけを抜き出して個別レポートを作成したいとき
- ✓クレーム対応履歴から未解決ステータスの案件のみを抽出して進捗管理シートを作りたいとき
- ✓商品在庫リストから在庫数が0の欠品商品だけを別シートに一覧化して発注リストを作成したいとき
- ✓全社の案件リストから自部署の案件だけを抜き出して、週次ミーティング用の資料を作成したいとき
- ✓顧客リストから特定の地域や業種の企業だけを抽出して、営業キャンペーンの対象リストを作りたいとき
💡 実装のヒント
- ▸検索値は部分一致で動作するため、「東京」と入力すると「東京都」「東京本社」などを含む行もすべて抽出されます。
- ▸抽出結果は新規シートに保存されるため、元データは変更されません。複数条件で繰り返し実行することも可能です。
- ▸列番号は1から始まる数値で指定します（A列=1、B列=2）。列名ではなく番号で指定する点に注意してください。
- ▸ヘッダー行も新しいシートにコピーされるため、抽出結果をそのまま資料として使えます。
- ▸抽出後のシートにAddSerialNumbersで番号を振れば、件数確認と一覧性が向上します。
💻 VBAコード
' CopyRowsIfCondition
' -----------------
' Macro Name: CopyRowsIfCondition
' Description: A列の値が指定したキーワードに一致する行を新しいシートにコピーします
' Parameters: なし
' Returns: なし
' Usage: CopyRowsIfCondition を実行し、検索キーワードを入力します
' -----------------
Sub CopyRowsIfCondition()
On Error GoTo ErrorHandler
Dim ws As Worksheet
Dim destWs As Worksheet
Dim keyword As String
Dim lastRow As Long
Dim destRow As Long
Dim i As Long
Set ws = ActiveSheet
keyword = InputBox("A列で検索するキーワードを入力してください", "条件指定")
If keyword = "" Then Exit Sub
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If lastRow < 2 Then
MsgBox "データが見つかりません", vbCritical, "エラー"
Exit Sub
End If
Set destWs = Worksheets.Add
destWs.Name = "抽出結果_" & Format(Now, "hhmmss")
ws.Rows(1).Copy destWs.Rows(1)
destRow = 2
For i = 2 To lastRow
If InStr(1, CStr(ws.Cells(i, 1).Value), keyword, vbTextCompare) > 0 Then
ws.Rows(i).Copy destWs.Rows(destRow)
destRow = destRow + 1
End If
Next i
MsgBox (destRow - 2) & " 行をコピーしました", vbInformation, "完了"
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub