Help request to get numbers of cards created in the message

Hi friends,

I’m not getting a numbers of cards created in the message. The message shows 0 cards are created.

Option Explicit

Sub ProgressCard()
'Create progress cards of students

    Dim Cell As Range
    Dim ln As Integer
    Dim i As Integer
    Dim pc As Long
    Dim pcNumberOfCards As Long
    Dim x As Long
    Dim rngCell As Range
    Dim Pic As Object
    
    
    Worksheets("ProgressCard").Range("a23:y1500").Clear
    
    For Each Pic In Worksheets("ProgressCard").Pictures
      If Not Intersect(Pic.TopLeftCell, Worksheets("ProgressCard").Range("a22:y1500")) Is Nothing Then
        Pic.Delete
      End If
    Next Pic

    ln = Application.InputBox("Enter number of cards to create.", Type:=1)
    i = Application.Max(Worksheets("Result").Range("A:A"))
    If i < ln Then
        MsgBox "I can only create " & i & " cards."
        ln = i
    End If
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    For i = 1 To ln
        With Worksheets("ProgressCard").Range("A5:y22")
            .Copy .Offset((i) * 18)
            .Offset((i) * 18).Range("y1").Value = i
           .Offset((i) * 18 + 3).Resize(1).Calculate
            .Offset((i) * 18 + 3).Resize(1).Value = .Offset((i) * 18 + 3).Resize(1).Value
End With
Next i
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    MsgBox "Congratulation. " & pcNumberOfCards & " progress cards are created.", 64 ‘here I want the number of cards created
End Sub

Any help will be highly appreciated.

Thanking you in anticipation.