'>> Userform; 1 listbox, 1 textbox; Code as follows
 
Option Explicit 
Option Compare Text 
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
     'Enter data on DoubleClick
    DoFill 
End Sub 
 
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 
     'Enter data if Enter key is pressed
    If KeyAscii = 13 Then DoFill 
End Sub 
 
Private Sub UserForm_Initialize() 
     'Store shortcut
    TextBox1 = ActiveCell.Value 
     'Populate list from appropriate sheet
    ListBox1.List() = Range("Ref" & TextBox1).Value 
     'Select first item in listbox
    ListBox1.ListIndex = 0 
     
End Sub 
 
Sub DoFill() 
    Dim MyCell As String 
    Dim Tmp1 As String, Tmp2 As String, Tmp3 As String, Tmp4 As String 
     
    Application.ScreenUpdating = False 
    MyCell = ActiveCell.Address 
    Worksheets("sheet" & TextBox1).Select 
     'Read in values from selected columns, based on list order
    Tmp1 = Cells(ListBox1.ListIndex + 1, 3).Value 
    Tmp2 = Cells(ListBox1.ListIndex + 1, 4).Value 
    Tmp3 = Cells(ListBox1.ListIndex + 1, 5).Value 
    Tmp4 = Cells(ListBox1.ListIndex + 1, 6).Value 
     
    Worksheets("Data").Select 
     'Select starting cell
    Range(MyCell).Select 
     'Write in values to selected columns; adjust as required
    ActiveCell.Offset(0, 0).Formula = Tmp1 
    ActiveCell.Offset(0, 1).Formula = Tmp2 
    ActiveCell.Offset(0, 2).Formula = Tmp3 
    ActiveCell.Offset(0, 3).Formula = Tmp4 
    ActiveCell.Offset(0, 3).Select 
     
    Unload UserForm1 
    Application.ScreenUpdating = True 
     
End Sub 
 
 '>> Standard module code
 
Sub Shows() 
    On Error Resume Next 
    UserForm1.Show False 
End Sub 
 
 'Called by WorkBook Open to create RangeNames
Sub DoNames() 
    Dim Nm, ShName As String, Ref As String 
    Dim i As Integer 
     
     'Delete names starting with Ref to avoid conflict
    For Each Nm In ActiveWorkbook.Names 
        If Left(Nm.Name, 3) = "Ref" Then Nm.Delete 
    Next 
     'Create names for each sheet except first for Columns A:C
    For i = 2 To Sheets.Count 
        Ref = "Ref" & Right(Sheets(i).Name, Len(Sheets(i).Name) - 5) 
        ShName = "=" & Sheets(i).Name & "!A:C" 
        ActiveWorkbook.Names.Add Name:=Ref, RefersTo:=ShName 
    Next 
End Sub 
 
 
 '>> "Sheet1" code
 
Option Explicit 
Option Compare Text 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
     
    If Target.Column() = 6 And Target.Text <> "" Then 
        DoNames 'Comment out this line if sheetname changes are not required
         'during normal use.  Names will be created on opening only.
        Target.Select 
        Shows 
    End If 
End Sub 
 
 '>> Workbook code
 
Private Sub Workbook_Open() 
     'Create RangeNames
    DoNames 
End Sub