Справочный лист на основе значения ячейки

Question

Я пользуюсь формой данных с этого сайта: http://www.contextures.com/exceldataentryupdateform.html См. Книгу «Форма ввода данных - Добавить/Обновить». Это простая форма ввода данных с рабочими макросами, и это здорово. На данный момент только лист PartsData обновляется, когда вы вносите изменения в лист ввода. Тем не менее, я хотел бы, чтобы страница ввода затем обновила данные на одном из листов, названных в поле «Части» (D6 в «Входной лист»), например. «Дверь», «Объектив», «Черная крышка». Очевидно, я могу создать эти листы и соответствующие данные с этими частями.

Я только хочу обновить лист с именем, аналогичным полю «Parts», выбранному на странице ввода.

Часть кода приведена ниже. Я просто не знаю, как настроить его так, чтобы Set historyWks = Worksheets("PartsData") сделал ссылку на ячейку (D6) на листе ввода. Остальная часть кода работает отлично, поэтому речь идет только об изменении Set historyWks = Worksheets("PartsData"). Есть идеи?

Sub UpdateLogWorksheet() 

Dim historyWks As Worksheet 
Dim inputWks As Worksheet 

Dim nextRow As Long 
Dim oCol As Long 

Dim myCopy As Range 
Dim myTest As Range 

Dim lRsp As Long 

Set inputWks = Worksheets("Input") 
Set historyWks = Worksheets("PartsData") 
oCol = 3 'order info is pasted on data sheet, starting in this column 

'check for duplicate order ID in database 
If inputWks.Range("CheckID") = True Then 
    lRsp = MsgBox("Order ID already in database. Update record?", vbQuestion + vbYesNo, "Duplicate ID") 
    If lRsp = vbYes Then 
    UpdateLogRecord 
    Else 
    MsgBox "Please change Order ID to a unique number." 
    End If 
Else 
    'cells to copy from Input sheet - some contain formulas 
    Set myCopy = inputWks.Range("OrderEntry") 

    With historyWks 
     nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row 
    End With 

    With inputWks 
     'mandatory fields are tested in hidden column 
     Set myTest = myCopy.Offset(0, 2) 

     If Application.Count(myTest) > 0 Then 
      MsgBox "Please fill in all the cells!" 
      Exit Sub 
     End If 
    End With 

    With historyWks 
     'enter date and time stamp in record 
     With .Cells(nextRow, "A") 
      .Value = Now 
      .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
     End With 
     'enter user name in column B 
     .Cells(nextRow, "B").Value = Application.UserName 
     'copy the order data and paste onto data sheet 
     myCopy.Copy 
     .Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True 
     Application.CutCopyMode = False 
    End With 

    'clear input cells that contain constants 
    ClearDataEntry 
End If 

End Sub 

Answer 1

Изменение, что линия от Set historyWks = Worksheets("PartsData") до Set historyWks = Worksheets(Range("D6").Value) Это будет использовать значение из D6, чтобы установить рабочий лист.

Answer 2

Объявите новую строку, чтобы сохранить имя целевого листа, а затем установить historyWks в строку.

dim strWksTarget as string 
strWksTarget = sheets("Input").Range("D6") 
set historyWks = sheets(strWksTarget)