Как я могу автоматически заполнить шаблон в Excel данными из другого листа?

Question

У меня есть «мастер-лист», в котором данные вводятся через каждую строку, причем каждая из них имеет уникальный ссылочный номер в первом столбце. Я хотел бы создать отдельные листы для каждой строки, но данные должны быть в определенном шаблоне, который отличается от того, как данные размещены в мастер-листе.

Я нашел код, который в основном позволяет мне делать следующее:

1) Выберите диапазон из моего основного листа, который содержит необходимые мне данные («Выберите диапазон исходных данных. Включите заголовки») 2) Найдите и выберите файл, в котором сохранен шаблон моей таблицы. 3) Откройте мой шаблон и выберите конкретные ячейки, которые вы хотите заполнить данными из каждого соответствующего столбца («Выберите диапазон (ы), чтобы заполнить его идентификатором отправителя. Удерживайте Ctr для выбора нескольких ячеек»).

После выбора места назначения для каждого столбца выполняется код и создается новый документ Excel с отдельным листом для каждой строки. Каждый лист назван в честь уникального ссылочного номера, который принадлежит его строке.

Вот моя проблема. Каждый раз, когда я запускаю код, я хотел бы исключить этап, на котором мне нужно пройти через выбор пунктов назначения. Есть ли способ, которым мой код уже знает, какую ячейку заполнить данными из столбца? Например, данные из столбца C всегда идут в A2, и я не хочу всегда выбирать A2.

' array list of fields to merge
Dim strMergeFields() As String
' range where merge data comes from
Dim rngSourceRange As Excel.Range

' path to workbook containing template
Dim strTemplatePath As String
' name of merge sheet on template
Dim strSheetName As String
' track user cancellation
Dim cancelled As Boolean

Private Sub initGlobals()
  Dim rngTemp As Excel.Range
  Dim wkbTemp As Excel.Workbook

  Dim iSize As Long
  Dim iCount As Long

  ' get source range
  On Error Resume Next
  Set rngSourceRange = Application.InputBox( _
    Prompt:="Select source data range. Include headers.", _
    Title:="Merge: Select Source Data", _
    Type:=8)
  On Error GoTo 0

  If rngSourceRange Is Nothing Then
    cancelled = True
    Exit Sub
  End If

  If (rngSourceRange.Rows.Count < 2) Then
    cancelled = True
    Call MsgBox("You must select a range with at least two rows.", _
              vbOKOnly + vbExclamation, "Merge: Error")
    Exit Sub
  End If

  ' resize array as needed
  iSize = rngSourceRange.Columns.Count
  ReDim strMergeFields(1 To iSize)

  ' get template file name
  With Application.FileDialog(Office.MsoFileDialogType.msoFileDialogFilePicker)
    .AllowMultiSelect = False
    With .Filters
      .Clear
      .Add "Excel Files", "*.xl*"
    End With
    If .Show = False Then
      cancelled = True
      Exit Sub
    End If
    strTemplatePath = .SelectedItems(1)
  End With

  Set wkbTemp = Application.Workbooks.Open(strTemplatePath)
  wkbTemp.Activate

  ' get ranges to populate
  For iCount = LBound(strMergeFields) To UBound(strMergeFields)
    On Error Resume Next
    Set rngTemp = Application.InputBox( _
        Prompt:="Select range(s) to populate with " & _
                rngSourceRange.Rows(1).Cells(iCount) & ". " & vbCrLf & _
                "Hold Ctrl to select multiple cells.", _
        Title:="Merge: Select Merge Fields", _
        Type:=8)
    On Error GoTo 0
    If rngTemp Is Nothing Then
      cancelled = True
      Exit Sub
    End If
    strMergeFields(iCount) = rngTemp.Address
    If Len(strSheetName) = 0 Then
      strSheetName = Application.ActiveWorkbook.ActiveSheet.Name
    Else
      If (strSheetName <> Application.ActiveWorkbook.ActiveSheet.Name) Then
        cancelled = True
        Call MsgBox("Merge fields must be on the same sheet.", _
            vbOKOnly + vbCritical, "Merge: Error")
        wkbTemp.Close (False)
        Exit Sub
      End If
    End If
  Next iCount

  wkbTemp.Close (False)
End Sub

Public Sub doMerge()
  Dim iSourceRow As Long
  Dim iFieldNum As Long

  Dim wkbTemp As Excel.Workbook
  Dim wshTemp As Excel.Worksheet
  Dim strTemp As String

  Call initGlobals
  If (cancelled) Then Exit Sub

  Dim answer As VBA.VbMsgBoxResult

  answer = MsgBox("Create separate workbook for each record?", _
            vbYesNoCancel, "How you wanna rip it?")

  If answer = vbCancel Then Exit Sub

  Application.ScreenUpdating = False

  If answer = vbNo Then
    Set wkbTemp = Application.Workbooks.Add(strTemplatePath)
  End If
  ' go through all row records
  For iSourceRow = 2 To rngSourceRange.Rows.Count
    ' make a new workbook based on template
    If answer = vbYes Then
      Set wkbTemp = Application.Workbooks.Add(strTemplatePath)
      Set wshTemp = wkbTemp.Worksheets(strSheetName)
    Else
      wkbTemp.Worksheets(strSheetName).Copy _
          after:=wkbTemp.Worksheets(wkbTemp.Worksheets.Count)
      Set wshTemp = wkbTemp.Worksheets(wkbTemp.Worksheets.Count)
    End If

wshTemp.Name = rngSourceRange.Cells(iSourceRow, 1).Value

    ' populate fields
    For iFieldNum = LBound(strMergeFields) To UBound(strMergeFields)
      wshTemp.Range(strMergeFields(iFieldNum)).Value = _
          rngSourceRange.Cells(iSourceRow, iFieldNum).Value
    Next iFieldNum

    If answer = vbYes Then
      ' make a name for the new merge
      strTemp = ThisWorkbook.Path
      If Right$(strTemp, 1) <> "\" Then
        strTemp = strTemp & "\"
      End If
      strTemp = strTemp & Format(Now(), "yyyy-mm-dd_hhmmss_") & "merge_" & iSourceRow - 1

    ' save the file and close
      wkbTemp.SaveAs strTemp, ThisWorkbook.FileFormat
      wkbTemp.Close False
    End If
  Next iSourceRow

  If answer = vbNo Then
      ' make a name for the new merge
      strTemp = ThisWorkbook.Path
      If Right$(strTemp, 1) <> "\" Then
        strTemp = strTemp & "\"
      End If
      strTemp = strTemp & Format(Now(), "yyyy-mm-dd_hhmmss_") & "merge"

      Application.DisplayAlerts = False
      wkbTemp.Worksheets(strSheetName).Delete
      Application.DisplayAlerts = True
    ' save the file and close
      wkbTemp.SaveAs strTemp, ThisWorkbook.FileFormat
      wkbTemp.Close False
  End If

  Application.ScreenUpdating = False

  Call MsgBox("Merge completed!", vbOKOnly + vbInformation, "Merge: Completed")
End Sub