VBA新手求助：代码无法实现多步骤工作表创建与数据粘贴流程

Hey there! I get it—having separate code snippets work but not when combined is super frustrating. Let's fix this by building a unified script that hits every step you outlined, with clear explanations so you understand what's going on.

The Core Issue #

Your existing code has two separate subroutines that don't talk to each other—one copies data across existing sheets, the other copies between two fixed sheets. We need to string together your desired workflow: copy → new sheet from template → paste → name → save as PDF.

Full Working Code #

Here's a complete, error-handled script that does exactly what you need. I've included comments and optional tweaks for flexibility:

Private Sub CommandButton1_Click()
    Dim srcSheet As Worksheet
    Dim templateSheet As Worksheet
    Dim newSheet As Worksheet
    Dim copyRange As Range
    Dim newSheetName As String
    Dim sheetCount As Integer
    
    ' Catch errors to avoid crashes and clean up
    On Error GoTo ErrorHandler
    
    ' --- Step 1: Copy specified range from your source sheet ---
    Set srcSheet = ThisWorkbook.Worksheets("Source") ' Replace with your actual source sheet name
    Set copyRange = srcSheet.Range("D12:L18") ' Replace with your target copy range
    copyRange.Copy ' Copy to clipboard
    
    ' --- Step 2: Create new sheet from Master Template ---
    Set templateSheet = ThisWorkbook.Worksheets("Master Template") ' Ensure this sheet exists!
    ' Copy template to end of workbook
    templateSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    Set newSheet = ActiveSheet
    
    ' --- Step 3: Paste data to the new sheet's target cells ---
    ' Paste only values (change to xlPasteAll if you need formats/formulas)
    newSheet.Range("D12").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False ' Clear clipboard to free memory
    
    ' --- Step 4: Name the new worksheet ---
    ' Option 1: Auto-numbered names (e.g., "Project 1", "Project 2")
    sheetCount = 0
    For Each sheet In ThisWorkbook.Worksheets
        If Left(sheet.Name, 8) = "Project " Then
            sheetCount = sheetCount + 1
        End If
    Next
    newSheetName = "Project " & (sheetCount + 1)
    
    ' Option 2: Let user input a custom name (uncomment below, comment Option 1)
    ' newSheetName = InputBox("Enter a name for the new worksheet:", "Name New Sheet")
    ' If newSheetName = "" Then newSheetName = "New Project " & Format(Now(), "yyyymmddhhmmss")
    
    ' Handle duplicate names to avoid errors
    On Error Resume Next
    newSheet.Name = newSheetName
    If Err.Number <> 0 Then
        newSheetName = newSheetName & "_" & Format(Now(), "hhmmss")
        newSheet.Name = newSheetName
    End If
    On Error GoTo ErrorHandler
    
    ' Notify user to start manual data entry
    MsgBox "New worksheet """ & newSheetName & """ created with copied data! You can now fill in the remaining details.", vbInformation
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Oops, something went wrong: " & Err.Description, vbCritical
    Application.CutCopyMode = False ' Clean up clipboard even if error occurs
End Sub

' --- Step 7: Save active worksheet as PDF ---
Sub SaveWorksheetAsPDF()
    Dim activeSheet As Worksheet
    Dim savePath As String
    
    Set activeSheet = ActiveSheet
    
    ' Save to your Documents folder with the sheet name as filename
    savePath = Environ("USERPROFILE") & "\Documents\" & activeSheet.Name & ".pdf"
    
    ' Export as PDF and open it automatically
    activeSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=savePath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
        
    MsgBox "PDF saved to: " & savePath, vbInformation
End Sub

Key Customization Tips #

• Source/Template Sheet Names: Double-check that "Source" and "Master Template" match the exact names in your workbook (case-sensitive!).
• Blank Sheet Instead of Template: If you don't need the template format, replace the template copy line with:

  Set newSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets.Count)
  

• Paste Options: Change xlValues to xlPasteAll if you want to copy formats/formulas, or xlPasteFormats for just formatting.
• Paste Location: Modify newSheet.Range("D12") to your target cell (e.g., Range("A1") to paste starting at the top-left).

How to Use #

1. Paste the first subroutine (CommandButton1_Click) into your button's code module.
2. Add a second button to your workbook, assign the SaveWorksheetAsPDF subroutine to it for the PDF step.
3. Test it out—each click of the first button will create a new template-based sheet with your copied data, no overwrites!

内容的提问来源于stack exchange，提问作者Newey