請測試看看， 謝謝。
Sub test()
Dim Arr, x%, FPath$, FD, FN, WB As Workbook, CT%, N%, M%
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
'========================================================================
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "D:\"
.AllowMultiSelect = True
.Show
Tm = Timer
For x = 1 To .SelectedItems.Count
FPath = .SelectedItems(x)
filedata = ActiveWorkbook.Name
Set WB = Workbooks.Open(FPath)
With Sheets(1)
If .FilterMode Then .ShowAllData
CT = Application.CountA([A1:A6636])
If CT < 2 Then GoTo 99
M = M + 1: FD = .[C1]
Arr = .Range(.[K3], .[A65536].End(3))
FN = Split(ActiveWorkbook.Name, ".")(0)
End With
99: WB.Close
If M = 1 Then
With Sheets("Summary")
N = .Range("A65536").End(xlUp).Row + 1
.Range("A" & N).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
.Range("I" & N).Resize(UBound(Arr)) = FD
.Range("K" & N).Resize(UBound(Arr)) = FN
End With
M = 0: Erase Arr
End If
Next
End With
