ブック間の値の確認、一致すれば転記

投稿者 : 東奔西走     投稿日時 : 2024/07/03(Wed) 13:26:50     OS : 未指定     EXCEL : 未指定

---

質問よろしくお願いします。
現在、過去の書類を整理しております。
内容は過去の勤務者の役職、契約形態、従業員名、部署名の確認と整理です。
2024年6月勤務表exclがあり、17.18行AB列結合されたセルに役職、17.18行C列結合されたセルに契約形態、17.18行D列結合されたセルに氏名、17.18行E列結合されたセルに部署A、17.18行F列結合されたセルに部署B、17.18行G列結合されたセルに部署C、17.18行H列結合されたセルに部署Dといった形となっています。所属部署には〇をつけています。
C、E～H列には入力規則が入っています。
2024年6月の勤務表が整理できれば、次は5月の整理、次は4月とさかのぼって目視で整理しています。
当月の従業員が正しく入力されているか、そして役職や契約形態、部署が入力されているか。
そこでできたらなと思うのが、仮に2024年6月exclが整理完成する→2024年6月exclと2024年5月exclの従業員名を照合→従業員名(値)が一致すれば→その人の役職・契約形態・部署を2024年6月exclから2024年5月exclにコピーする→次は2024年5月exclと2024年4月excl～と過去分を繰り返す。

以上のようなことを考えているのですが、vbaで可能でしょうか？
拙い説明で申し訳ありませんが、よろしくお願いします。

参考画像：https://ibb.co/CzrPYGc

投稿者 : 東奔西走     投稿日時 : 2024/07/03(Wed) 13:50:52

---

すいません。
可能でしたら、6月と5月など月同士を照合するブックでできたらなと考えております。
社内的に、他の人でも使えるツール的な物があればよいのかなと思いまして。
質問している身なのに申し訳ないです。

投稿者 : さんこう     投稿日時 : 2024/07/03(Wed) 15:06:50

---

＞6月と5月など月同士を照合するブックでできたらなと考えております。

ありがちなテーマですので、ネットで探せばそれらしいものが見つかるかと思います。

多少のアレンジは必要になるでしょうけれど。


参考になれば。

＜VBA 名簿 新旧照合＞
https://www.google.com/search?q=VBA+%E5%90%8D%E7%B0%BF+%E6%96%B0%E6%97%A7%E7%85%A7%E5%90%88

投稿者 : 東奔西走     投稿日時 : 2024/07/03(Wed) 17:11:09

---

何度もすいません。
説明が下手で申し訳ないです。

6月の例：https://ibb.co/Bs5yVsk
5月の例：https://ibb.co/W2xVSk5

6月整理→5月（名前はすでにある）の整理→4月（名前はすでにある）の整理→繰り返し
のような形です。

投稿者 : さんこう     投稿日時 : 2024/07/03(Wed) 17:49:09

---

ありがちなテーマですので、ネットで探せばそれらしいものが見つかるかと思います。

多少のアレンジは必要になるでしょうけれど。


参考になれば。

＜VBA 名簿 転記＞
https://www.google.com/search?q=VBA+%E5%90%8D%E7%B0%BF+%E8%BB%A2%E8%A8%98

投稿者 : さんこう     投稿日時 : 2024/07/03(Wed) 18:00:42

---

参考になれば。

Sub adfsdf()
    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\" & "2024年6月.xlsx")
    Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & "2024年5月.xlsx")
    Set ws1 = wb1.Worksheets(1)
    Set ws2 = wb2.Worksheets(1)
    
    r = 17
    Do While ws1.Cells(r, "D") <> ""
        s = 17
        Do While ws2.Cells(s, "D") <> ""
            If ws1.Cells(r, "D") = ws2.Cells(s, "D") Then
                For c = 1 To 8
                    ws2.Cells(s, c) = ws1.Cells(r, c)
                Next
                Exit Do
            End If
            s = s + 2
        Loop
        r = r + 2
    Loop
    
End Sub