excel - セルを集めてアクティブワークシートに書き込む

Question

CollectTimesheetData.xlsm には、A1、B1、および C1 セルに次の見出しがあります。

従業員名 プロジェクト名 総請求可能時間

実行ボタンを作成しましたが、その中に以下のマクロが含まれています。私がやろうとしていることは次のとおりです。

1. ユーザーにフォルダの選択を求める
2. そのフォルダー内のすべての .xls ファイルを 1 つずつ実行します。
3. 選択したフォルダー内のすべての xls ファイルからセル値 B7、B14、および R28 を読み取ります
4. 1枚目のxlsファイルはA2にB7、B2にB14、C2にR28を書き、
5. 2枚目のxlsファイルはA3にB7、B3にB14、C3にR28と書いて、
6. 3 番目の xls ファイルでは、A4 に B7、B4 に B14、C4 に R28 などを記述します。

私が持っているのは以下のマクロです：

Sub Button1_Click()

Dim fd As Object, myfiles As String, result, tempfile As Workbook, j As Long, i As Long

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show <> -1 Then Exit Sub

ChDir (fd.SelectedItems(1))

myfiles = Dir(fd.SelectedItems(1) & Application.PathSeparator & "*.xls")

ReDim result(1 To Rows.Count, 1 To 1)

Application.ScreenUpdating = 0
j = 2

Do While myfiles <> ""

    Set tempfile = Workbooks.Open(myfiles)
    ActiveSheet.Cells(j, 1).Value = tempfile.Sheets(1).Range("B7")
    ActiveSheet.Cells(j, 2).Value = tempfile.Sheets(1).Range("B14")
    ActiveSheet.Cells(j, 3).Value = tempfile.Sheets(1).Range("R28")

    j = j + 1
    tempfile.Close 0
    myfiles = Dir

Loop

Application.DisplayAlerts = 1
Application.ScreenUpdating = 1

End Sub

問題は、実行され、エラーも例外もありませんが、現在アクティブなワークシートにも何も書き込まれないことです。

ここで何が欠けていますか？