日付と名前が同じだったらコピーしたいです

投稿者 : 新入社員     投稿日時 : 2025/06/20(Fri) 17:53:14     OS : 未指定     EXCEL : 未指定

---

はじめまして。
シートAとシートBの日付と名前が同じだったら（一致したら）、シートAの勤務パターンをシートBのG列（勤務パターン列）にコピーしたいのですが、可能でしょうか？
シート同士、列や行が同じ形でないとやはり難しいでしょうか？
もし、可能でしたらマクロを教えていただけますでしょうか。
根本的に無理なことでしたら諦めます。

シートA　https://ibb.co/99TN2q9P
シートB　https://ibb.co/hx17hFYQ

投稿者 : てらてら     投稿日時 : 2025/06/20(Fri) 20:07:41

---

こんにちは。

シートBの職員名が下にずらっと並ぶなら、以下のようになるかと思います。
参考にしてみてください。

Sub macro()
    Dim lastColA As Long, lastRowB As Long
    
    Dim shA As Worksheet
    Dim shB As Worksheet
    Set shA = Worksheets("シートA")
    Set shB = Worksheets("シートB")
    lastColA = shA.Cells(17, Columns.Count).End(xlToLeft).Column    'シートAの最終列
    lastRowB = shB.Cells(Rows.Count, "B").End(xlUp).Row 'シートBの最終行
    
    Dim i As Long, j As Long, k As Long
    Dim name As String
    For i = 22 To 23    '名前列
        name = shA.Cells(i, "C")
        
        For j = 4 To lastColA
            For k = 6 To lastRowB
            
                '名前が同じで日付も同じ
                If name = shB.Cells(k, "E") And _
                    shA.Cells(17, j) = shB.Cells(k, "B") Then
                    
                    shB.Cells(k, "G") = shA.Cells(i, j) '勤務タイプ
                    Exit For
                    
                End If
                
            Next k
        Next j
    Next i
    
End Sub

投稿者 : ピロリ     投稿日時 : 2025/06/21(Sat) 06:49:04

---

■[質問] 新入社員さん（2025-06-20 17:53:14）の記事
＞ シートAとシートBの日付と名前が同じだったら（一致したら）･･･
ということですが、単純に、
シートBのE6セルに入力されている職員名で シートAのC列を検索。見付かった職員の勤務パターンを
全日数分コピーし、シートBのG6セルから縦方向に貼付けるってことでは駄目ですか？
シートBの画像を見る限り「日付と職員名を比較せずとも･･･ 」と思ったのですが。
外していたらご免なさい。　読み捨てて下さい。

Sub Sample()
    Dim shA As Worksheet: Set shA = Worksheets("シートA")   'シートAの指定
    Dim shB As Worksheet: Set shB = Worksheets("シートB")   'シートBの指定
    Dim r As Range, days As Long
    Set r = shA.Columns("C").Find(shB.Range("E6"))          'AシートC列を職員名検索して、
    If Not r Is Nothing Then                                '職員名が見付かったら、
        days = shA.Range("D18").End(xlToRight).Column - 3   'シートAの日数を取得する
        r.Offset(0, 1).Resize(1, days).Copy                 '勤務タイプを日数分コピーし、
        shB.Range("G6").PasteSpecial Paste:=xlPasteAll, _
                                     Transpose:=True        'Bシートへ縦方向に貼付ける
        Application.CutCopyMode = False                     '最後に、コピーモードは解除
    End If
End Sub

投稿者 : 新入社員     投稿日時 : 2025/06/23(Mon) 21:33:55

---

てらてら 様、ピロリ 様

私なんかの為にお時間割いて、マクロ教えていただきありがとうございます。
お二人のおかげで解決しました！
本当にありがとうございます！