VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。

Sh1（入力シート）のI25セルに枚数、K25セルに金額等のデータをSh4（A9引換帳）の
G列、Q列等に転記するコードですが、Sh4に表示されません。次のコードのどこに原因があるか教えて下さい。なお、都合上　画像を添付できない旨ご理解ください。
Sub A9引換帳()
Dim mRow As Long
If Not IsDate(Range("I8").Value) Then Exit Sub ' セルI8の値が日付でない場合、サブルーチンを終了する
Select Case Month(Range("I8").Value) ' セルI8の値が日付である場合、その月を取得する
' 以下に各月ごとの処理を記述する
Case 4: mRow = 1 ' ４月の場合の処理をする、以下同じ
Case 5: mRow = 38
Case 6: mRow = 95
Case 7: mRow = 139
Case 8: mRow = 176
Case 9: mRow = 218
Case 10: mRow = 265
Case 11: mRow = 307
Case 12: mRow = 349
Case 1: mRow = 393
Case 2: mRow = 433
Case 3: mRow = 475
End Select
Call Giftbook_main(mRow)
End Sub

Public Sub Giftbook_main(mRow As Long)
Dim sh4 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim Row As Long
Dim dicT As Object
Dim key1 As Variant
Dim key2 As Variant
Dim mRow As Long
Dim lastRow As Long ' 最後の記録行を追跡する変数

Set sh4 = Worksheets("A9引換帳")
Set sh1 = Worksheets("入力シート")

Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh1.Cells(Rows.Count, "E").End(xlUp).Row 　'E伝票番号（一連番号）

For Row = 8 To maxrow '８行から最終までの行
key1 = sh4.Cells(Row, "E").Value 'A9引換帳の伝票番号"E"の値の行
dicT(key1) = Row
Next

'伝票番号を記憶
key2 = sh1.Cells(8, "E").Value
dicT(key2) = Row
If dicT.exists(key2) = False Then
Exit Sub
End If

If sh1.Cells(8, "L").Value = "" Then
MsgBox ("年が未表示です")
End If
Row = dicT(key1)

If sh1.Cells(25, "I").Value = "0" Then 'A9セルの枚数が"0"ならば
sh4.Cells(Row + mRow, "F").EntireRow.Delete 'A9引換帳のF列の（Row + mRow）行目を削除する
End If
'A9引換帳に転記する。
If sh1.Cells(25, "I").Value <> "0" And sh1.Cells(25, "I").Value <> "0" Then '25行目の"I"列のセルの値が"0"でない場合
' 最後の記録行を更新
Do While sh4.Cells(lastRow + mRow + 1, "F").Value <> "" '(lastRow + mRow + 1)行目の"F"列のセルの値が空でない間、
lastRow = lastRow + 1 'lastRowの値を1ずつ増やす処理を繰り返す
Loop

lastRow = lastRow + 1

sh4.Cells(lastRow + mRow, "F").Value = sh1.Cells(12, "E").Value '名前
sh4.Cells(lastRow + mRow, "G").Value = sh1.Cells(25, "I").Value '枚数
sh4.Cells(lastRow + mRow, "D").Value = sh1.Cells(8, "N").Value '日
sh4.Cells(lastRow + mRow, "C").Value = sh1.Cells(8, "M").Value '月
sh4.Cells(lastRow + mRow, "E").Value = sh1.Cells(8, "E").Value '伝票番号
sh4.Cells(lastRow + mRow, "Q").Value = sh1.Cells(25, "K").Value '金額

End If

' 重複チェック
Dim exists As Boolean
exists = False

Dim i As Long
For i = 8 To sh4.Cells(Rows.Count, "E").End(xlUp).Row
If sh4.Cells(i, "E").Value = sh1.Cells(8, "E").Value Then
exists = True
Exit For
End If
Next i

If Not exists Then
' データを転記する
sh4.Cells(lastRow + 1, "F").Value = sh1.Cells(12, "E").Value '名前
sh4.Cells(lastRow + 1, "G").Value = sh1.Cells(25, "I").Value '枚数
sh4.Cells(lastRow + 1, "D").Value = sh1.Cells(8, "N").Value '日
sh4.Cells(lastRow + 1, "C").Value = sh1.Cells(8, "M").Value '月
sh4.Cells(lastRow + 1, "E").Value = sh1.Cells(8, "E").Value '伝票番号
sh4.Cells(lastRow + 1, "Q").Value = sh1.Cells(25, "K").Value '金額

End If
End Sub

No.1 ベストアンサー 回答者： zongai 回答日時： 2024/01/08 17:35

Public Sub Giftbook_main(mRow As Long)　内の

この宣言を削除。
Dim mRow As Long

ここは、andで綴っているのが同じ条件なので、条件指定間違いでなければ1つでいい。
If sh1.Cells(25, "I").Value <> "0" And sh1.Cells(25, "I").Value <> "0" Then '25行目の"I"列のセルの値が"0"でない場合

ざっくりと動作するであろう範囲でブックを作成して実行したところでは、「A9引換帳」で設定したmRow+1行目に転記されました。
実際にうまく動作しない状態のサンプルデータが検証しやすいのですが…。

この回答へのお礼

大変有難うございました。ご教授頂いたとおり、宣言を削除したところ適正な行に表示されました。

お礼日時：2024/01/08 18:14