このコードでできること

・入力フォームの内容をSheet2へ登録
・チェック済みデータのみSheet3へ転記
・完了案件と未完了案件を自動で振り分け

VBAコード

Sub 登録処理()

    Dim wsForm As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim nextRow2 As Long
    Dim nextRow3 As Long

    Set wsForm = Worksheets("案件入力フォーム") ' 入力フォーム
    Set ws2 = Worksheets("案件データベース")
    Set ws3 = Worksheets("新規登録名簿")

    ' Sheet2へ転記（必ず）
    nextRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1

    ws2.Cells(nextRow2, 1).Value = wsForm.Range("C2").Value '案件名
    ws2.Cells(nextRow2, 2).Value = wsForm.Range("C3").Value '顧客名
    ws2.Cells(nextRow2, 3).Value = wsForm.Range("C4").Value '担当者
    ws2.Cells(nextRow2, 4).Value = wsForm.Range("C5").Value '受注日
    ws2.Cells(nextRow2, 5).Value = wsForm.Range("C6").Value '金額
    ws2.Cells(nextRow2, 6).Value = wsForm.Range("C7").Value 'ステータス
    ws2.Cells(nextRow2, 7).Value = wsForm.Range("C8").Value '備考

    ' 完了チェックがある場合のみSheet3へ
    If wsForm.Range("C9").Value = "1" Then

        nextRow3 = ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row + 1

        ws3.Rows(nextRow3).Value = ws2.Rows(nextRow2).Value

    End If

End Sub

カスタマイズ例

パターン①

完了以外に「保留」も転記する

If wsForm.Range("C9").Value = "1" Or wsForm.Range("C7").Value = "保留" Then

    nextRow3 = ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row + 1

    ws3.Rows(nextRow3).Value = ws2.Rows(nextRow2).Value

End If

パターン②

チェックが入ったらメッセージを表示する

If wsForm.Range("C9").Value = "1" Then

    nextRow3 = ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row + 1

    ws3.Rows(nextRow3).Value = ws2.Rows(nextRow2).Value

    MsgBox "完了案件を転記しました"

End If

よくあるエラー

症状

チェックを入れても「新規登録名簿」へ転記されない

対処法
・C9セルが「☑」になっているか確認
・参照セルが変更されていないか確認

症状

実行時エラー「インデックスが有効範囲にありません」

対処法
・シート名を確認する
・「案件入力フォーム」「案件データベース」「新規登録名簿」が存在するか確認する

サンプルファイル

このコードを試せるサンプルファイルを配布しています。

▶ サンプルファイルをダウンロード（.zip）

関連記事

▶ VBAで入力フォームの内容を別シートへ登録するコード

▶ VBAで入力フォームを自動クリアするコード

▶ VBAで疑似チェックボックスを作成する方法

次回予告

次回は「VBAで担当者別にデータを集計するコード」を紹介予定です。