Sub TEST()
Dim A As Range, B As Range, N%
Dim X As New Application, FN$, xB As Workbook
For Each A In [F4:G4]
N = N + 1
FN = ThisWorkbook.Path & "\" & A.Value & "記錄.xlsx"
If Dir(FN) = "" Then GoTo 101
Set xB = X.Workbooks.Open(FN)
For Each B In [E5:E14]
On Error Resume Next
If Range(B.Value) Is Nothing Then GoTo 102
On Error GoTo 0
xB.Sheets(1).Range(B).Value = B(1, N + 1)
102: Next
xB.Close 1
101: Next
End Sub
