excel - コードエラー、把握できません

Question

修正されたコード: 「下付き文字が範囲外です」というエラーが表示されるようになりました。

以下のコードに問題があります。

このコードは、同じフォルダーにファイルの複数のコピーを作成しています。

これに伴い、作成された新しいワークブックの新しいシートに新しいファイルの「ファイル名」をコピーできるようにするステートメントをコードに追加しました。

実行するとエラーが発生します:application defined or object defined error

コードに欠けているものを誰か教えてもらえますか? ご協力ありがとうございました。

    Sub CopyFile()
Dim i As Integer
Dim j As Integer
Dim Subfolder As String
Dim Sourcefile As String
Dim Targetfile As String
Dim targetwb As Workbook
Dim targetsheet As Worksheet
Dim myFSO As Object

Subfolder = "J:\Temp\Data\Report\"
Sourcefile = "Hospital .xls" 'The original file name
Set myFSO = CreateObject("Scripting.FileSystemObject")
'loop from A2 to A53
i = 2
Do While ActiveSheet.Cells(i, 1).Value <> Empty
'determine Targetfilename
Targetfile = Subfolder & ActiveSheet.Cells(i, 1).Value & ".xls"
'copy file
myFSO.CopyFile Subfolder & Sourcefile, Targetfile, True 'true will overwrite existing files
i = i + 1
Loop
Set myFSO = Nothing
targetwb = Workbooks(Targetfile)
targetsheet = targetwb("Sheet12")
j = 2
Do While targetsheet.Cells(j, 3).Value <> Empty
targetsheet.Cells(j, 3).copy
targetsheet.Cells(4).Paste
j = j + 1
Loop
End Sub