Private Sub Worksheet_Change(ByVal Target As Range)
Dim f As Worksheet, rng As Range
If Target.Address <> "$D$3" Then Exit Sub
If Target.Count = 1 Then
If Len(Target) > 0 Then
Set f = Worksheets(Target.Text)
Set rng = f.Range(f.Cells(5, "E"), f.Cells(Rows.Count, "E").End(3))
Me.Range("B5").Resize(rng.Rows.Count).Value = rng.Value
End If
End If
End Sub