如何使用其他工作表中的数据自动填充excel中的模板？

Question

我有一个“主表”，在该表的每一行中输入数据，每行在第一列中都有唯一的参考号。我想为每一行创建单独的工作表，但是将数据放在一个特定的模板中，该模板与数据在主表中的布局方式不同。

我发现基本上可以执行以下操作的代码：

1）从我的主表中选择一个包含我需要的数据的范围（“选择源数据范围。包括标题”） 2）浏览并选择保存我的表格模板的文件 3）打开我的模板，然后从每个相应的列中选择要填充数据的特定单元格（“选择要使用原始发件人ID号填充的范围。按住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