Sub CopyIfChanged_ScheduleToBKURecord_AllAtOnce()
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim srcRow As Long
Dim dstRow As Long
Dim foundCell As Range
Dim col As Long
Dim isDifferent As Boolean
Dim lastDstRow As Long
Dim copyRange As Range
Dim firstDstRow As Long
' シート設定
Set wsSrc = ThisWorkbook.Worksheets("スケジュール")
Set wsDst = ThisWorkbook.Worksheets("BKURecord")
' BKURecordの最終行取得
lastDstRow = wsDst.Cells(wsDst.Rows.count, "C").End(xlUp).row
If lastDstRow < 4 Then lastDstRow = 3
firstDstRow = lastDstRow + 1
' 転記対象を一時的に格納するための配列的 Range
Dim transferRows As Collection
Set transferRows = New Collection
' スケジュール C4:C53 を確認
For srcRow = 4 To 53
If Trim(wsSrc.Cells(srcRow, "C").value) <> "" Then
' BKURecordで一致するC列を検索
Set foundCell = wsDst.Range("C4:C1003").Find( _
What:=wsSrc.Cells(srcRow, "C").value, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If foundCell Is Nothing Then
' 一致なし → 新規転記対象
transferRows.Add wsSrc.Range("B" & srcRow & ":H" & srcRow)
Else
' 一致あり → D～H列を比較
isDifferent = False
For col = 4 To 8 ' D～H列
If wsSrc.Cells(srcRow, col).value <> wsDst.Cells(foundCell.row, col).value Then
isDifferent = True
Exit For
End If
Next col
If isDifferent Then
transferRows.Add wsSrc.Range("B" & srcRow & ":H" & srcRow)
End If
End If
End If
Next srcRow
' 転記対象がある場合まとめて転記
If transferRows.count > 0 Then
dstRow = firstDstRow
Dim rng As Range
For Each rng In transferRows
wsDst.Range("B" & dstRow & ":H" & dstRow).value = rng.value
dstRow = dstRow + 1
Next rng
MsgBox "転記済み (" & transferRows.count & " 件)", vbInformation
Else
MsgBox "転記なし", vbInformation
End If
End Sub