display date last used a macro

Thanks for the help, I've tried adding the line to a macro, but I keep getting the error:

"Runtime error 9: subscript out of range"

Before adding the following line, the macro worked perfectly:
'Copy date to certain cell in certain sheet to know when was last update
Worksheets("Sheet1").Range("E3").Value = Now()

What am I doing wrong? Thanks!

Option Explicit


        

Public Sub subMySuggestion()

    'Copy date to certain cell in certain sheet to know when was last update
   Worksheets("Sheet1").Range("E3").Value = Now()

Dim intSourceRw As Integer    '(or maybe "Long" depending on # row s in "Boekhouding"
Dim intReceivedRw As Integer
Dim strPageNm As String
Dim strCol(5) As String
Dim intCount As Integer
    intSourceRw = 2
    
    Do Until Cells(intSourceRw, 1) = Empty
        If Cells(intSourceRw, 9) = Empty Then
            strPageNm = Cells(intSourceRw, 8)
            Else: strPageNm = Cells(intSourceRw, 9)
        End If
 'Assign contents to array
        strCol(0) = Cells(intSourceRw, 2)
        strCol(1) = Cells(intSourceRw, 10)
        strCol(3) = Cells(intSourceRw, 4)
        strCol(4) = Cells(intSourceRw, 5)
        strCol(5) = Cells(intSourceRw, 1)
        
        Sheets(strPageNm).Select
        intReceivedRw = fnFER(10, 1)
'Paste array to receiving sheet
        For intCount = 0 To 5
            Cells(intReceivedRw, intCount + 1) = strCol(intCount)
        Next
        Sheets("Boekhouding").Select
        intSourceRw = intSourceRw + 1
    Loop
    
End Sub
Public Function fnFER(lngRw, lngCol) As Long
'Returns row # of first empty cell in Column(lngCol): cells(lngRw, lngCol)
    Do Until Cells(lngRw, lngCol) = ""
        lngRw = lngRw + 1
    Loop
    fnFER = lngRw
End Function