Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim i As Long
Dim j As Long
Dim copyRange As Range
Dim destRange As Range

‘ シートの設定
Set ws1 = ThisWorkbook.Sheets(“Sheet1”)
Set ws2 = ThisWorkbook.Sheets(“Sheet2”)

‘ 最終行の取得
lastRow1 = ws1.Cells(ws1.Rows.Count, “B”).End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, “C”).End(xlUp).Row

‘ Sheet1のB列とSheet2のC列の比較
For i = lastRow1 To 1 Step -1
If ws1.Cells(i, “B”).Value <> “” Then
For j = 1 To lastRow2
If ws1.Cells(i, “B”).Value = ws2.Cells(j, “C”).Value Then
‘ 行の挿入
ws1.Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
‘ B列の値のコピー
ws1.Cells(i + 1, “B”).Value = ws1.Cells(i, “B”).Value
‘ 追加した行のE列とG列に0を入力
ws1.Cells(i + 1, “E”).Value = 0
ws1.Cells(i + 1, “G”).Value = 0
‘ Sheet2のI列からL列のデータをSheet1のH列にコピー（同じ値があった行）
Set copyRange = ws2.Range(ws2.Cells(j, “I”), ws2.Cells(j, “L”))
Set destRange = ws1.Range(ws1.Cells(i, “H”), ws1.Cells(i, “K”))
destRange.Value = copyRange.Value
‘ Sheet2のI列からL列のデータをSheet1のH列にコピー（追加した行）
Set copyRange = ws2.Range(ws2.Cells(j + 1, “I”), ws2.Cells(j + 1, “L”))
Set destRange = ws1.Range(ws1.Cells(i + 1, “H”), ws1.Cells(i + 1, “K”))
destRange.Value = copyRange.Value
Exit For ‘ 一致が見つかったら内側のループを抜ける
End If
Next j
End If
Next i