Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim strDir$, fName$
strDir = ThisWorkbook.Path & "\"
fName = Target.Value & ".xls"
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Open strDir & fName
If Err = 0 Then
With Workbooks(fName)
.Sheets("Sheet1").UsedRange.Copy ThisWorkbook.Sheets("A").Range("A1")
.Close False
End With
Else
MsgBox ("The file '" & fName & "' does not exist in the folder being searched."), , fName & " not found"
End If
Err.Clear
Application.ScreenUpdating = True
End Sub