Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const filename As String = "L:\temp\excel\autoFile.xlsx"
Dim strValue As String
Dim wbk As Workbook
Dim rng As Range
Set rng = refersToRange("Buttons")
If Not Intersect(rng, Target) Is Nothing Then
strValue = Target.Cells(1, 1).Value
If Not strValue = "" Then
Set wbk = GetWorkbook(filename)
If wbk Is Nothing Then
Set wbk = Application.Workbooks.Open(filename:=filename)
Else
wbk.Activate
End If
wbk.Worksheets(1).Range("B18").Value = strValue
End If
End If
End Sub
Function GetWorkbook(sFilename As String) As Workbook
Dim wbk As Workbook
For Each wbk In Application.Workbooks
If wbk.FullName = sFilename Then
Set GetWorkbook = wbk
Exit For
End If
Next
End Function
Function refersToRange(sName As String) As Range
Dim rng As Range
Dim wsh As Worksheet
Dim strRng As String
Dim strItem As Variant
Dim nm As Name
Set nm = ThisWorkbook.Names(sName)
strRng = Right(nm.RefersTo, Len(nm.RefersTo) - 1)
For Each strItem In Split(strRng, ",")
If rng Is Nothing Then
Set rng = Worksheets(1).Range(strItem)
Else
Set rng = Union(rng, Range(strItem))
End If
Next
Set refersToRange = rng
End Function