Excel VBA需求：将指定单元格复制到模板新工作簿指定位置

Let's work through your problem step by step. Your current code has a couple of critical issues (like duplicate workbook creation) and is missing the core cell mapping and multi-row iteration logic you need. Here's a complete, tested solution that meets all your requirements:

Full Corrected VBA Code #

Sub CopyToLog()
    Dim SlctRange As Range
    Dim strTemplatePath As Variant
    Dim wbTemplate As Workbook
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim rw As Range
    ' Define your cell mapping: source cell (from Sheet1) -> target cell (in template)
    Dim cellMappings As Variant
    cellMappings = Array( _
        Array("A", "B3"), _
        Array("C", "F8"), _
        Array("H", "H6") _
    )
    
    ' Set reference to your source sheet (Sheet1)
    Set sourceWs = ThisWorkbook.Sheets("Sheet1")
    
    ' Step 1: Let user select the rows to process (enforce row selection)
    On Error Resume Next
    Set SlctRange = Application.InputBox( _
        Prompt:="Select the rows you want to process (click and drag to select multiple rows):", _
        Title:="Select Rows", _
        Default:=Application.Selection.Address, _
        Type:=8 _
    )
    On Error GoTo 0
    
    ' Exit if user cancels selection
    If SlctRange Is Nothing Then Exit Sub
    
    ' Step 2: Let user select the template file (more flexible than hardcoding)
    strTemplatePath = Application.GetOpenFilename( _
        FileFilter:="Excel Template Files (*.xlsx; *.xlst), *.xlsx; *.xlst", _
        Title:="Select the Model Template File" _
    )
    
    ' Exit if user cancels template selection
    If strTemplatePath = False Then Exit Sub
    
    ' Step 3: Process each selected row
    For Each rw In SlctRange.Rows
        ' Create a new workbook from the template
        Set wbTemplate = Workbooks.Open(strTemplatePath)
        Set targetWs = wbTemplate.Sheets(1) ' Assuming target is first sheet in template
        
        ' Step 4: Copy mapped cells from source row to target workbook
        Dim mapping As Variant
        For Each mapping In cellMappings
            ' Get source cell (column from mapping, row from selected row)
            Dim sourceCell As Range
            Set sourceCell = sourceWs.Cells(rw.Row, mapping(0))
            
            ' Paste value (or use .Copy/.PasteSpecial if you need formatting)
            targetWs.Range(mapping(1)).Value = sourceCell.Value
            
            ' Optional: If you need to copy formatting too, replace above line with:
            ' sourceCell.Copy
            ' targetWs.Range(mapping(1)).PasteSpecial xlPasteAll
            ' Application.CutCopyMode = False
        Next mapping
        
        ' Optional: Save the new workbook (customize path/name as needed)
        ' wbTemplate.SaveAs "C:\Your\Save\Path\Log_" & Format(Now(), "YYYYMMDD_HHMMSS") & ".xlsx"
        
        ' Keep workbook open, or uncomment below to close it after processing
        ' wbTemplate.Close SaveChanges:=True
    Next rw
    
    MsgBox "All rows processed successfully!", vbInformation
End Sub

Key Fixes & Improvements Explained #

• Removed duplicate workbook creation: Your original code created two workbooks (wb and NewBook) — we now only create one workbook per selected row from the template.
• Multi-row support: Added a For Each rw In SlctRange.Rows loop to process every selected row individually.
• Flexible cell mapping: The cellMappings array lets you easily add/modify source-target cell pairs without rewriting core logic. Just add new Array("SourceColumn", "TargetCell") entries.
• Template path flexibility: Instead of hardcoding the template name, we use GetOpenFilename to let you select the template file each time (avoids issues if the template moves).
• Error handling: Added checks for user cancellation (if they click "Cancel" in the input boxes, the macro exits cleanly).
• Optional features: Included commented-out code for saving the new workbooks automatically, or copying cell formatting if needed.

How to Use #

1. Open your Excel workbook with Sheet1 and Sheet2.
2. Press Alt + F11 to open the VBA Editor.
3. Insert a new module (Right-click your workbook in the Project Explorer > Insert > Module).
4. Paste the code above into the module.
5. Adjust the cellMappings array to match your exact source and target cells.
6. Run the macro — you'll be prompted to select rows, then select the template file, and it will process each row into a new template-based workbook.

内容的提问来源于stack exchange，提问作者Giacomo Viganò