・入力フォームの内容をデータベースへ登録できる
・チェックが入ったデータだけ別シートへ転記できる
・VBA初心者でもコピペで利用可能
このコードでできること
・入力フォームの内容を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セルが「☑」になっているか確認
・参照セルが変更されていないか確認
症状
実行時エラー「インデックスが有効範囲にありません」
対処法
・シート名を確認する
・「案件入力フォーム」「案件データベース」「新規登録名簿」が存在するか確認する
サンプルファイル
このコードを試せるサンプルファイルを配布しています。
関連記事
次回予告
次回は「VBAで担当者別にデータを集計するコード」を紹介予定です。


コメント