期限切れデータ（今日より前の日付）を自動抽出！別シートにコピーするExcel VBAコード【コピペOK】

「期限切れのデータだけ集めて一覧にしたい」
「日付でフィルターをかけるのが手間…」

そんなあなたにおすすめなのが、“今日より前の日付”のデータだけを、別のシートに自動で抽出してくれるVBAコードです。

今回は、C列にある日付をチェックして、期限切れの行を「期限切れ一覧」というシートにまとめる方法をご紹介します。

このEXcelVBAはこんな方におすすめです！！

締切超過した案件だけをまとめて確認したい方
手作業でフィルター＆コピーするのが面倒な方
管理用の“期限切れ一覧”をExcelで作りたい方

Sub ExtractPastDueRows()
    Dim srcWs As Worksheet
    Dim destWs As Worksheet
    Dim lastRow As Long
    Dim pasteRow As Long
    Dim i As Long
    Dim dateCol As String
    Dim headerRange As Range

    ' 元データのシートを指定（アクティブシート）
    Set srcWs = ActiveSheet
    dateCol = "C" ' 日付の列（例：C列）

    ' 出力先シート名を指定（なければ作成）
    On Error Resume Next
    Set destWs = Worksheets("期限切れ一覧")
    If destWs Is Nothing Then
        Set destWs = Worksheets.Add
        destWs.Name = "期限切れ一覧"
    Else
        destWs.Cells.ClearContents ' 既存内容を削除
    End If
    On Error GoTo 0

    ' ヘッダーをコピー
    Set headerRange = srcWs.Range("A1").EntireRow
    headerRange.Copy Destination:=destWs.Range("A1")
    pasteRow = 2

    ' 元データの最終行を取得
    lastRow = srcWs.Cells(srcWs.Rows.Count, dateCol).End(xlUp).Row

    ' 2行目からチェックして、期限切れ行をコピー
    For i = 2 To lastRow
        If IsDate(srcWs.Cells(i, dateCol).Value) Then
            If srcWs.Cells(i, dateCol).Value < Date Then
                srcWs.Rows(i).Copy Destination:=destWs.Rows(pasteRow)
                pasteRow = pasteRow + 1
            End If
        End If
    Next i

    MsgBox "期限切れのデータを「期限切れ一覧」に抽出しました！"
End Sub

期限切れのデータだけを自動でまとめることで、見落とし防止や対応のスピードアップにつながります。

VBAを活用すれば、面倒なフィルター＆コピペ作業も1クリックで完了！

今後も「実務でそのまま使えるVBAコード」を紹介していきますので、「こんなコードが欲しい！」などあれば、ぜひコメントください！！