同一ブック内で、片方のシートのデータをもう一方のシートに転記していくマクロを作成していますがうまくいきません。
シート1(移動データ)
|顧客番号|氏名|カナ氏名|
|1|山田 太郎|ヤマダ タロウ|
|4|佐藤 次郎|サトウ ジロウ|
シート2(顧客一覧)
|顧客番号|氏|名|カナ氏|カナ名|
|1|山田|太郎|ヤマダ|タロウ|
|2|鈴木|花子|スズキ|ハナコ|
###前提・実現したいこと
シート1(移動データ):アクセスデータベースから更新したデータ一覧
シート2(顧客一覧):顧客リスト
シート1を更新後、シート1のデータのうち、シート2の顧客データにまだ記載されていない顧客データについてシート2に追記を行う。追加データについては、シート2の末尾に書式コピーをした後に追記していく。
というマクロを作成したいのですが以下の問題が発生しました。
シート1の顧客番号で重複データを検索し、シート2に反映させています。
###発生している問題・エラーメッセージ
1.既存データに上書きされています。
2.また、繰り返し処理がうまくいっていないようですべての未入力データが反映されません。
エラーメッセージ
Public Sub 顧客一覧更新()
Dim 顧客番号 As Long
Dim I As Long
Dim 顧客一覧 As Worksheet
Dim 移動データ As Worksheet
Dim 演習問題_顧客一覧 As Workbook
Dim 検索_cell As Range
Dim 編集対象行 As Long
I = 1
Do Until Cells(I, 1) = "" '<== 1列目(A列)が【空になるまで】ループ処理を続行します(Untilキーワードで判定)
'ループ内で繰り返し処理される内容です If Sheets("移動データ").Range("A" & I) = 顧客番号 Then Exit Do '対象の顧客番号を見つけたらループを終了する End If I = I + 1 Loop
'③対象の顧客番号が顧客一覧に登録済かどうか確認する
'描画OFF Application.ScreenUpdating = False Sheets("顧客一覧").Activate With Sheets("顧客一覧") Columns("A:A").Select Set 検索_cell = Selection.Find(What:=.Range("A:A"), After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False) If 検索_cell Is Nothing Then '顧客番号が未登録の時 Range("A1028576").Select Selection.End(xlDown).Select 'Ctrl+↑で最終行を検索 編集対象行 = Selection.Row + 1 If 編集対象行 > 3 Then '2行目(行番号=4)以降は最終行の書式をコピーして新規行を作成する Rows(編集対象行 - 1).Select Selection.Copy Rows(編集対象行).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End If Else 編集対象行 = 検索_cell.Row End If Range("A" & 編集対象行) = .Range("B3") '顧客番号 Range("B" & 編集対象行) = Trim(.Range("B6")) & " " & Trim(.Range("D6")) '氏名 Range("C" & 編集対象行) = Trim(.Range("B5")) & " " & Trim(.Range("D5")) 'カナ氏名
End With
'描画ON Application.ScreenUpdating = True
End Sub
###試したこと
###補足情報(言語/FW/ツール等のバージョンなど)