🔄
CopyRowsIfCondition
データ処理A列の値が指定したキーワードに一致する行を新しいシートにコピーします
🎬 デモGIF準備中
📖 使い方
- VBAエディタを開く（Alt + F11）
- モジュールを挿入（挿入 > モジュール）
- 下記VBAコードをコピー&ペースト
- ブック上で実行（Alt + F8 でマクロ選択）
💡 実行例： CopyRowsIfCondition を実行し、検索キーワードを入力します
💻 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