Excel VBA 定型フォーマットの複数ファイルから一覧作成

■やりたい事

①定型フォーマットのExcelファイル（＝対象ファイル）が複数存在

②対象ファイルは全て同じフォルダに保存

③対象ファイルの必要項目を抽出して、VBAマクロを実行するブック（＝自ブック）内に一覧シート作成

④一覧シートを作成するブックに対して、別内容の表を作成する既存処理あり

⑤一覧シートの内容は、対象ファイルのキー項目で昇順ソート

■やった事

Option Explicit
Const SAVEFOLDER As String = "保存フォルダ名"
Public Sub 一覧作成()
Application.ScreenUpdating = False '画面描画　停止
Application.Calculation = xlCalculationManual '再計算　手動
If offAlert Then Application.DisplayAlerts = False 'アラートの非表示

Dim fs As Object: Set fs = CreateObject("Scripting.FileSystemObject")
Dim fpath As String: fpath = ThisWorkbook.path & "\" & SAVEFOLDER & "\"
Dim files As Object: Set files = fs.GetFolder(fpath).files()
Dim file As Object

ThisWorkbook.Activate
Sheets.Add
Cells(1, 1) = "ヘッダ1" 'ヘッダ行項目名記入
'（中略）

Dim row As Integer: row = 2
For Each file In files '既存表作成
'対象ファイルからデータ取得
Call Workbooks.Open(file.path, ReadOnly:=True)
Dim data As Variant
data = Range("A1:G999")
ActiveWorkbook.Close

Cells(row, 1) = data(1, 2) 'Range配列データを対象セルへ入力　斜体はサンプル値
'（中略）
row = row + 1
Next
Set files = Nothing

data = Range(Cells(1, 1), Cells(row, 10)) '既存表からデータ取得

Sheets.Add '一覧シート作成
Range("a1").Activate
Dim intRow, intCol As Integer
For intRow = 2 To row
For intCol = 28 To 49
If data(intRow, intCol) <> "" Then
ActiveCell.Value = data(1, intCol)
ActiveCell.Offset(0, 1).Value = data(intRow, 1)
ActiveCell.Offset(1, 0).Activate
End If
Next intCol
Next intRow

With ActiveSheet
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("A1"), Order:=xlAscending
.Sort.SortFields.Add Key:=.Range("B1"), Order:=xlAscending
.Sort.SetRange .Range("A:C")
.Sort.Header = xlNo
.Sort.Apply
End With

Application.ScreenUpdating = True '画面描画　再開
Application.Calculation = xlCalculationAutomatic '再計算　自動
If offAlert Then Application.DisplayAlerts = True 'アラートの表示
End Sub