別ブックへのセル照合転記

Question

前提・実現したいこと

テーマ：転記元ﾌｧｲﾙからﾏｸﾛ実行し、転記先ﾌｧｲﾙへ照合と転記
①転記元ﾌｧｲﾙのｾﾙA2から最終行(ｾﾙへ入力済)の値（A2,A3,A4...）に対して、
転記先ﾌｧｲﾙのｾﾙA2から最終行(ｾﾙへ入力済)の値（A2,A3,A4...）を照合
②合致した場合は、転記先該当ｾﾙ(A2,A3,A4...)へ上書き
③合致しない場合は、転記先最終行(ｾﾙへ入力済)の次行へ転記
④ﾏｸﾛ実行完了後、転記先ﾌｧｲﾙは閉じる
条件：ﾏｸﾛ実行の範囲として、常にA2以降の入力済ｾﾙ全行を照合

発生している問題・エラーメッセージ

・"ｲﾝﾃﾞｯｸｽが有効範囲にありません"というｴﾗｰが発生してしまいます。
・別ブックへの複数ある検索値を１つずつ照合し転記するｺｰﾄﾞも記載したのですが、
正解が分からずご相談させていただきました。

該当のソースコード

Sub 別ブックへの転記△2()
Const TenkiMoto As String = "C:\テスト" '転記元ﾌｧｲﾙﾊﾟｽ
Const TenkiSaki As String = "C:\Users\nakagami\Desktop\サンプル" '転記先ﾌｧｲﾙﾊﾟｽ
Dim TM As Workbook '転記元ﾌｧｲﾙ名変数
Dim TS As Workbook '転記先ﾌｧｲﾙ名変数
Dim lastrowM As Long   '転記元最終行数取得
Dim lastrowS As Long   '転記先最終行数取得
Dim wsM As Worksheet '転記元ﾜｰｸｼｰﾄ変数
Dim wsS As Worksheet '転記先ﾜｰｸｼｰﾄ変数
Dim i As Long '転記元行数ｶｳﾝﾀ
Dim j As Long '転記先入力ｶｳﾝﾀ
Dim numberM As Variant  '転記元検索値
Dim resultS As Variant '転記先検索結果

    Set TM = ThisWorkbook                               'このマクロがあるﾌｧｲﾙが転記元
    Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx")  '転記先ﾌｧｲﾙ名を変数格納

    Set wsM = TM.Worksheets(1) '転記元ｼｰﾄを変数格納
    Set wsS = TS.Worksheets(1) '転記先ｼｰﾄを変数格納

    lastrowM = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row  '転記元ｼｰﾄ最終行数抽出
    lastrowS = wsS.Cells(wsS.Rows.Count, 1).End(xlUp).Row '転記先ｼｰﾄ最終行数抽出

    For i = 2 To lastrowM  '転記元検索値が存在するまで繰り返す
        numberM = wsM.Cells(i, 1).Value  '転記元検索値を変数格納
        If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then
            lastrowS = lastrowS + 1
            wsS.Cells(lastrowS, 1) = numberM
            wsS.Cells(lastrowS, 2) = wsM.Cells(i, 2).Value
            wsS.Cells(lastrowS, 3) = wsM.Cells(i, 3).Value
        Else 'こちらから合致した場合の上書き処理をしたいと考えております。
            
        End If
    Next i
    TS.Close SaveChanges:=True

End Sub

●転記元ﾌｧｲﾙ中身

●転記元ﾌｧｲﾙﾊﾟｽ：C:\テスト\転記元.xlsm

●転記先ﾌｧｲﾙ中身

●転記先ﾌｧｲﾙﾊﾟｽ：C:\Users\nakagami\Desktop\サンプル\転記先.xlsx

ここにより詳細な情報を記載してください。

Comments

[m.ts10806]

エラーはどこで（どのときに）起きていますか？
また、そのときデバッグモードになるかと思いますが
各変数には何が入っていますか？

[meg_]

> ・"ｲﾝﾃﾞｯｸｽが有効範囲にありません"というｴﾗｰが発生してしまいます。
”何処で”それが発生するのでしょうか？

[jabe]

ご連絡ありがとうございます。
はい、デバッグモードになります。
エラーはC:\Users\nakagami\Desktop\サンプル\転記先.xlsxの行で発生してしまいます。変数はNothingになっています。

[jinoji]

実現したいことの記述 と 説明画像 と コード が微妙に食い違ってます。
画像から想像すると、転記元のC列の値が転記先のC列になかったら、転記先最終行の次行に転記
その際、A列は転記元そのままではなく転記先の中での連番（最終行の値＋１）を、
B,C列は転記元の値をセットする、という仕様なのかな、と思えます。

あと、フォルダパスは C:\Users\jabe\Desktop\サンプル とかがいいかもです。

エラーは、たぶんWorkbooks(xxxxx) の使い方が正しくないために起きていると思われます。
以下のいずれかのようにすれば解消すると思います。
Workbooks(1) 　　　　　　　・・・いま開いている1つ目のブック
Workbooks("転記元.xlsm")　　・・・フルパスではNG

[jabe]

連絡ありがとうございます。
言葉足らずで申し訳ありません。今回は連番せず番号不一致の場合のみあらたに転記と考えています。

フォルダパス気を付けます。

なるほどです。変数の勢いでﾌﾙﾊﾟｽを入れていました。

Answer 1

これでどうでしょうか。

'   Set TM = Workbooks.Open(TenkiMoto & "\テスト\転記元.xlsm")  '転記元ﾌｧｲﾙ名を変数格納
    Set TM = ThisWorkbook                               'このマクロがあるﾌｧｲﾙが転記元
    Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx")  '転記先ﾌｧｲﾙ名を変数格納

    Set wsM = TM.Worksheets(1) '転記元ｼｰﾄを変数格納
    Set wsS = TS.Worksheets(1) '転記先ｼｰﾄを変数格納

    lastrowM = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row  '転記元ｼｰﾄ最終行数抽出
    lastrowS = wsS.Cells(wsS.Rows.Count, 1).End(xlUp).Row '転記先ｼｰﾄ最終行数抽出

    For i = 2 To lastrowM  '転記元検索値が存在するまで繰り返す
        numberM = wsM.Cells(i, 2).Value  '転記元検索値を変数格納
        If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then
            lastrowS = lastrowS + 1
            wsS.Cells(lastrowS, 1) = numberM
        End If
    Next i

Comments

[jabe]

ご丁寧にご回答していただきありがとうございます。
狙い通りに動作しました。

以下コードについて、教えてください。
If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then
今回のサンプルの際以下のように処理されますが、③の処理範囲がA2:(2,1)の為、②の転記セルが範囲対象外になっていると思うのですが、プログラムは問題なく動作していますので、どうい理屈になっていますでしょうか？

①転記元ｾﾙ値1の場合_lastrowS＝2_if判定＝1_検索範囲：A2:(1,1)
②転記元ｾﾙ値2の場合_lastrowS＝2_if判定＝0_検索範囲：A2:(1,1)
③転記元ｾﾙ値3の場合_lastrowS＝3_if判定＝0_検索範囲：A2:(2,1)

[jinoji]

Range("A2").Resize(2, 1) は
A2セルを起点にした2行×1列の範囲、
つまりRange("A2:A3")ということですので、
②で転記するA3セルは範囲対象に含んでいます。

[jinoji]

もっとシンプルに
If WorksheetFunction.CountIf(wsS.Range("A:A"), numberM) = 0 Then
でもよかったかもしれません。

[jabe]

説明とアドバイスしていただき、ありがとうございます。
検索範囲頭を起点として範囲という事でresizeﾌﾟﾛﾊﾟﾃｨ理解する事が出来ました。
なるほど、A列すべて検索という方法もあるんですね。

[jabe]

jinojiさん、質問からｽﾃｯﾌﾟｱｯﾌﾟしてしまうのですが、以下相談させてください。
・このｺｰﾄﾞで照合合致した際に、ｾﾙ上書きをさせたい場合は、どのような処理を実施すればよろしいでしょうか？
※私なり、ｺｰﾄﾞ編集し再ｱｯﾌﾟﾛｰﾄﾞさせていただきましたので、お手数お掛けしますが、ご確認をお願い致します。

[jinoji]

照合合致した際にｾﾙ上書き、というのがよく分からないのですが、
元ファイルのA2セルの値は転記先のA2セルと合致する→ 元ファイルのA2セルを転記先のA2セルに上書きする？

[jinoji]

たとえばこういうことですか？
If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then
lastrowS = lastrowS + 1
wsS.Cells(lastrowS, 1) = numberM
wsS.Cells(lastrowS, 2) = wsM.Cells(i, 2).Value
wsS.Cells(lastrowS, 3) = wsM.Cells(i, 3).Value
Else '合致した場合の上書き処理
Dim matchrow
matchrow = WorksheetFunction.Match(numberM, wsS.Range("A:A"), False)
wsS.Cells(matchrow, 1) = numberM
wsS.Cells(matchrow, 2) = wsM.Cells(i, 2).Value
wsS.Cells(matchrow, 3) = wsM.Cells(i, 3).Value
End If

[jabe]

迅速な対応ありがとうございます。
まさにその通りです。狙い通り動作しました、うれしいです。

match関数で判別するやり方勉強になりました。
使いこなせれるように頑張ります。
ﾜｰｸｼｰﾄ関数奥が深いです。