【VBA】条件に合う行を別シートにコピー・移動する方法（コピペOK）

完成イメージ（Before / After）

—

条件に合う行を別シートにコピー・移動するVBAは、Rows.Copy と最終行取得を組み合わせるだけで実現できる。

なお、最終行の取得方法を詳しく知りたい場合は データの最終行・最終列を正確に取得する方法 を参照。

—

実行前の準備

バックアップを取る

特に行移動（コピー元の行を削除する処理）を使う場合、元に戻せない。必ずファイルのコピーを別フォルダに保存してから実行する。

Excelをマクロ有効ブック（.xlsm）で保存する

拡張子が .xlsx のままだとマクロが保存できない。

1. 「ファイル」→「名前を付けて保存」
2. ファイルの種類を「Excelマクロ有効ブック (*.xlsm)」に変更
3. 保存

—

手順（コピペ → 実行まで約5分）

VBE（コードを書く画面）を開く

1. Excelで Alt + F11 を押す

標準モジュールを挿入する

1. VBEのメニュー →「挿入」→「標準モジュール」

コードを貼り付けて実行する

1. コードウィンドウに、下のコードをそのままコピペする
2. Alt + F8 → マクロ名を選んで「実行」

ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法は マクロをボタン1つで実行する方法 を参照。

—

コード（最小版）– 条件に合う行を別シートにコピー

Sheet1のA列が「営業部」の行をSheet2にコピーする。まずはこれで動きを確認する。

'============================================================
' ■ 条件一致行を別シートにコピー（最小版）
'   → Sheet1のA列が指定値と一致する行をSheet2にコピー
'============================================================
Sub CopyRowsByCondition()

    '--- ★書き換えポイント ---
    Dim srcSheetName As String
    srcSheetName = "Sheet1"       '← コピー元のシート名

    Dim destSheetName As String
    destSheetName = "Sheet2"      '← コピー先のシート名

    Dim checkCol As Long
    checkCol = 1                  '← 判定する列（A列=1）

    Dim conditionValue As String
    conditionValue = "営業部"     '← コピー条件の値
    '--- ★ここまで ---

    Dim wsSrc As Worksheet
    Set wsSrc = Worksheets(srcSheetName)

    Dim wsDest As Worksheet
    Set wsDest = Worksheets(destSheetName)

    '--- コピー元の最終行を取得
    Dim lastRow As Long
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, checkCol).End(xlUp).Row

    '--- コピー先の次の空き行を取得
    Dim destRow As Long
    destRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1

    Dim r As Long
    Dim copyCount As Long
    copyCount = 0

    For r = 2 To lastRow  '← 1行目はヘッダーなので2行目から
        If CStr(wsSrc.Cells(r, checkCol).Value) = conditionValue Then
            wsSrc.Rows(r).Copy Destination:=wsDest.Cells(destRow, 1)
            destRow = destRow + 1
            copyCount = copyCount + 1
        End If
    Next r

    MsgBox copyCount & " 行をコピーしました。", vbInformation

End Sub

書き換えポイント

ポイント: Rows.Copy Destination:= を使うと、値・書式・行の高さがまとめてコピーされる。なぜ Rows.Copy を使うかというと、セルの値だけでなく罫線や背景色も含めて「行まるごと」移せるので、コピー先シートの見た目がコピー元と同じになるからだ。セルの値に数値が入っている場合は CLng() や CDbl() で型を合わせてから比較するとよい。CStr() で文字列比較しているため、数値の 100 と文字列の "100" が不一致になるケースに注意すること。値だけ転記する方法は セルの転記を自動化する方法 を参照。

また、For r = 2 To lastRow でループの開始を2行目にしているのは、1行目がヘッダー行だから。ヘッダーが2行ある場合は For r = 3 To lastRow に変更すれば対応できる。最終行の取得と組み合わせることで、データ件数が変動しても自動で全行を処理してくれる。

—

コード（実務版）– 複数条件・行移動・ヘッダー自動コピー・進捗表示付き

この方法を覚えてからは、月末の部門別集計だけでなく、ステータスが「完了」の行を別シートにアーカイブする運用にも使っている。「終わったデータが消えて一覧がスッキリする」と同僚にも好評だった。

※ 行移動オプションをONにすると、コピー元の行が削除されます。実行前に必ずバックアップを取ってください。

'============================================================
' ■ 条件一致行を別シートにコピー・移動（実務版）
'   → 複数条件対応、行移動（コピー元削除）、ヘッダー自動コピー
'   → 進捗表示、高速化処理、エラーハンドリング付き
'============================================================
Sub CopyOrMoveRowsAdvanced()

    '--- ★書き換えポイント ---
    Dim srcSheetName As String
    srcSheetName = "Sheet1"           '← コピー元のシート名

    Dim destSheetName As String
    destSheetName = "Sheet2"          '← コピー先のシート名

    Dim checkCol As Long
    checkCol = 1                      '← 条件1の判定列（A列=1）

    Dim conditionValue As String
    conditionValue = "営業部"         '← 条件1の値

    Dim checkCol2 As Long
    checkCol2 = 3                     '← 条件2の判定列（C列=3）。使わない場合は0

    Dim conditionValue2 As String
    conditionValue2 = "完了"          '← 条件2の値

    Dim useAndCondition As Boolean
    useAndCondition = True            '← True=AND条件、False=OR条件

    Dim deleteAfterCopy As Boolean
    deleteAfterCopy = False           '← True=行移動（コピー元を削除）、False=コピーのみ

    Dim copyHeader As Boolean
    copyHeader = True                 '← True=ヘッダー行（1行目）を自動コピー
    '--- ★ここまで ---

    '--- シートの取得
    Dim wsSrc As Worksheet
    Dim wsDest As Worksheet

    On Error Resume Next
    Set wsSrc = Worksheets(srcSheetName)
    Set wsDest = Worksheets(destSheetName)
    On Error GoTo 0

    If wsSrc Is Nothing Then
        MsgBox "コピー元シート「" & srcSheetName & "」が見つかりません。", vbExclamation
        Exit Sub
    End If

    If wsDest Is Nothing Then
        MsgBox "コピー先シート「" & destSheetName & "」が見つかりません。", vbExclamation
        Exit Sub
    End If

    '--- コピー元の最終行を取得
    Dim lastRow As Long
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, checkCol).End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "データがありません。", vbExclamation
        Exit Sub
    End If

    '--- ヘッダー行のコピー
    Dim destRow As Long
    If copyHeader Then
        If wsDest.Cells(1, 1).Value = "" Then
            wsSrc.Rows(1).Copy Destination:=wsDest.Cells(1, 1)
        End If
    End If

    destRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
    If destRow = 2 And wsDest.Cells(1, 1).Value = "" Then
        destRow = 1
    End If

    '--- 高速化設定
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    '--- エラー発生時も必ず設定を戻す
    On Error GoTo CleanUp

    Dim r As Long
    Dim copyCount As Long
    Dim val1 As String
    Dim val2 As String
    Dim isMatch As Boolean
    copyCount = 0

    '--- ループで条件判定 → コピー
    For r = 2 To lastRow
        val1 = CStr(wsSrc.Cells(r, checkCol).Value)

        '--- 条件判定
        If checkCol2 = 0 Then
            isMatch = (val1 = conditionValue)
        Else
            val2 = CStr(wsSrc.Cells(r, checkCol2).Value)
            If useAndCondition Then
                isMatch = (val1 = conditionValue) And (val2 = conditionValue2)
            Else
                isMatch = (val1 = conditionValue) Or (val2 = conditionValue2)
            End If
        End If

        If isMatch Then
            wsSrc.Rows(r).Copy Destination:=wsDest.Cells(destRow, 1)
            destRow = destRow + 1
            copyCount = copyCount + 1
        End If

        '--- 進捗表示（50行ごと）
        If r Mod 50 = 0 Then
            Application.StatusBar = "処理中... " & r & " / " & lastRow & " 行"
            DoEvents
        End If
    Next r

    '--- 行移動（コピー元の行を削除）-- 下から上にループ ★重要
    If deleteAfterCopy And copyCount > 0 Then
        For r = lastRow To 2 Step -1
            val1 = CStr(wsSrc.Cells(r, checkCol).Value)

            If checkCol2 = 0 Then
                isMatch = (val1 = conditionValue)
            Else
                val2 = CStr(wsSrc.Cells(r, checkCol2).Value)
                If useAndCondition Then
                    isMatch = (val1 = conditionValue) And (val2 = conditionValue2)
                Else
                    isMatch = (val1 = conditionValue) Or (val2 = conditionValue2)
                End If
            End If

            If isMatch Then
                wsSrc.Rows(r).Delete
            End If
        Next r
    End If

CleanUp:
    '--- 高速化設定を戻す（エラー時も必ず実行される）
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.StatusBar = False

    If Err.Number <> 0 Then
        MsgBox "エラーが発生しました。" & vbCrLf & _
               "エラー番号: " & Err.Number & vbCrLf & _
               "内容: " & Err.Description, vbCritical
        Exit Sub
    End If

    '--- 結果表示
    Dim msg As String
    msg = copyCount & " 行をコピーしました。"
    If deleteAfterCopy Then
        msg = msg & vbCrLf & "コピー元から " & copyCount & " 行を削除しました。"
    End If
    MsgBox msg, vbInformation

End Sub

実務版のコードを使い始めてから、月末の部門別振り分けが本当に楽になった。もっと早く知りたかった。

実務版では Application.ScreenUpdating = False で画面更新を止め、Application.Calculation = xlCalculationManual で再計算を手動に切り替えている。なぜこの2つを設定するかというと、行をコピーするたびにExcelが画面を描き直し、数式を再計算すると、数百行の処理で体感10倍以上遅くなるからだ。処理が終わったら CleanUp ラベルで必ず元に戻す設計にしている。こうしておけば、途中でエラーが発生しても設定が戻らないまま放置される心配がない。高速化テクニックの詳細は 画面更新・再計算を止めてマクロを高速化する方法 を参照。

行移動（deleteAfterCopy = True）を使うときの削除ループが別になっている理由も重要だ。コピーと削除を1つのループでまとめると、行を削除するたびに行番号がずれて正しくコピーできなくなる。そのため「まずコピーだけ完了→そのあと下から上に削除」という2段階構成にしている。行列の挿入・削除でも同じ考え方が使える。

書き換えポイント

シート構成の例

コピー元（Sheet1）:

コピー先（Sheet2）– 実行後（条件: A列=営業部 AND C列=完了）:

—

よくある落とし穴5選

1. 行削除を上から順にやると行がずれて半分しか消えない

自分もこれで1時間溶かした。上から順に Rows(r).Delete したら、削除のたびに下の行が繰り上がって、ループが1行飛ばしになる。結果、条件に合う行が半分しか消えなかった。原因に気づいたときは「なんでこんな単純なことに…」と脱力した。

2. コピー先シートが存在しないとエラーになる

3. ヘッダー行まで条件判定の対象になってしまう

4. 文字列の前後に空白が入っていて条件が一致しない

全角・半角の不一致が原因の場合は、StrConv(値, vbNarrow) で半角に統一してから比較する方法もある。文字列変換の詳細は 全角⇔半角を一括変換してデータを統一する方法 を参照。

5. ScreenUpdatingをFalseにしたままエラーで止まると画面が固まる

手動で戻す場合はVBEのイミディエイトウィンドウに Application.ScreenUpdating = True と入力してEnter。エラー処理の詳しい書き方は エラー処理（On Error）で止まらないマクロを作る方法 を参照。

VBAで行コピーが別シートにできないときの対処法

「Rows.Copyを実行したのにコピー先シートにデータが入らない」という場合、原因はコピー先シート名のスペルミスか、Destination引数の指定方法が間違っていることが多い。Rows(r).Copy Destination:=wsDest.Cells(destRow, 1) のようにシート変数を明示して、貼り付け先の開始セルを指定する必要がある。シート変数を付け忘れると、コピー元シート自身に貼り付けてしまう。自分もこれで「コピーしたはずなのにSheet2が空のまま」と焦ったことがある。シート変数の付け忘れは転記系マクロで最も多いミスだ。

VBAのRows.Copyで貼り付け先がずれるときの対処法

「条件に合う行をコピーしたら、コピー先の行がずれて空白行が混ざる」という場合、原因はコピー先の開始行（destRow）を毎回更新していないことだ。destRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1 でコピー先の最終行を取得し、コピーのたびに destRow = destRow + 1 でインクリメントする必要がある。もう1つの原因は、コピー元の行削除を上から順にやっていて行番号がずれているケース。行を削除するときは必ず For r = lastRow To 2 Step -1 で下から上にループすること。

VBAで行移動後にデータが半分しか消えないときの対処法

「deleteAfterCopyをTrueにしたのに、コピー元に行が半分残っている」という場合、原因は行を上から順に削除していることだ。3行目を削除すると元の4行目が3行目に繰り上がるため、ループが1行飛ばしになる。対処法は行削除のループを For r = lastRow To 2 Step -1 で下から上に回すこと。実務版コードではコピーと削除を2段階に分けて、削除ループを逆順にする設計にしているのでそのまま使えば問題ない。

—

FAQ

Q1: コピーではなく移動（コピー元の行を削除）にしたい

実務版コードの deleteAfterCopy = True に変更する。コピー後にコピー元の該当行を下から上に向かって削除する。必ずバックアップを取ってから実行すること。

Q2: 複数の条件で絞り込みたい（AND/OR）

実務版コードで対応している。checkCol2 に2つ目の条件列、conditionValue2 に値を指定する。useAndCondition = True でAND条件、False でOR条件になる。条件が不要な場合は checkCol2 = 0 にすれば条件1のみで動作する。

Q3: コピー先シートがなければ自動で作りたい

以下のコードを、シート取得の部分に追加する。

On Error Resume Next
Set wsDest = Worksheets(destSheetName)
On Error GoTo 0
If wsDest Is Nothing Then
    Set wsDest = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    wsDest.Name = destSheetName
End If

シート名に使えない文字（\ / * ? : [ ]）が含まれるとエラーになるので注意。

Q4: 値だけコピーしたい（書式は不要）

Rows.Copy Destination:= の代わりに、値だけ転記する方法を使う。

wsDest.Rows(destRow).Value = wsSrc.Rows(r).Value

セル転記の詳しい方法は セルの転記を自動化する方法 を参照。

Q5: オートフィルタで絞り込んでからコピーする方法との違いは？

オートフィルタは SpecialCells(xlCellTypeVisible) で可視行をまとめてコピーできるため、大量データでは高速。一方、1行ずつループする方法は条件分岐が柔軟（AND/OR/部分一致など自由に書ける）。用途に応じて使い分けるとよい。オートフィルタを使った方法は オートフィルタでデータを絞り込み・解除する方法 を参照。

—

まとめ

• 最小版: Rows.Copy Destination:= で条件一致行を別シートにコピーできる
• 実務版: 複数条件・行移動・ヘッダー自動コピー・進捗表示に対応
• 行移動の鉄則: 行を削除するときは Step -1 で下から上にループ。上から削除すると行がずれる
• バックアップ必須: 特に行移動（行削除）を使う場合は、実行前に必ずファイルをコピーしておく

条件に合う行を別シートにコピーする処理は、VBAの中でも「作って良かった」と思えるマクロの1つだ。まずは最小版で1条件のコピーを試し、慣れてきたら実務版で複数条件や行移動を使ってみてほしい。一度作れば、月末のデータ振り分け作業が数秒で終わるようになる。

関連記事

• データの最終行・最終列を正確に取得する方法 — コード内で使う最終行取得の詳細
• セルの転記を自動化する方法 — 値だけ転記したい場合の基本
• 複数条件でデータを抽出して別シートにまとめる — オートフィルタを使った抽出方法
• 空白行・空白セルを一括で削除する方法 — 行移動後の空白行処理
• 複数シートに同じ処理を一括実行 — 複数部門シートへの振り分けの発展

—

次にやりたくなること

• 複数条件でデータを抽出して別シートにまとめる: オートフィルタを使ったデータ抽出で、大量データをさらに高速に処理したい場合
• オートフィルタでデータを絞り込み・解除する方法: フィルタの設定・解除をVBAで自動化して、手動フィルタ操作を減らしたい場合