VBA宏需求：按条件导出工作表并优化粘贴逻辑

Let’s tackle your two main issues head-on with targeted fixes and improvements:

1. Implementing Proper Worksheet Filtering #

Your original code looped through every sheet without checking exclusions or the H32 value condition. We’ll add clear logic to skip unwanted sheets and only process those that meet your criteria.

2. Streamlining PasteSpecial for Values & Formats #

Your current PasteSpecial calls were redundant and included operations that brought in formulas. We’ll simplify this to paste only values and formatting—exactly what you need.

Modified Working Code #

Sub exporttoworkbook()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$
    MyFilePath$ = ActiveWorkbook.Path & "\" & "Statements of Work"
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False ' Prevent unwanted macro triggers during execution
    End With
    
    On Error Resume Next
    MkDir MyFilePath ' Create target folder if it doesn't exist
    On Error GoTo 0 ' Reset error handling to catch other issues later
    
    ' Loop through each worksheet (more reliable than index-based looping)
    For Each Sheet In ThisWorkbook.Worksheets
        ' Check exclusion list and H32 value condition
        If Sheet.Name <> "macro" And Sheet.Name <> "report" Then
            ' Ensure H32 is numeric to avoid errors before checking value
            If IsNumeric(Sheet.Range("H32").Value) And Sheet.Range("H32").Value > 0 Then
                SheetName = Sheet.Range("$A$4").Value
                
                ' Copy only the used range for efficiency (instead of all cells)
                Sheet.UsedRange.Copy
                
                ' Create new workbook with a single worksheet
                Dim newWB As Workbook
                Set newWB = Workbooks.Add(xlWBATWorksheet)
                
                With newWB.ActiveSheet
                    ' Paste values first, then formatting (no formulas included)
                    .PasteSpecial Paste:=xlPasteValues
                    .PasteSpecial Paste:=xlPasteFormats
                    .Name = "Quality Sign-off"
                    .Range("A1").Select
                End With
                
                ' Save and close the new workbook
                newWB.SaveAs Filename:=MyFilePath & "\" & SheetName & ".xlsx"
                newWB.Close SaveChanges:=False ' No need to save again—we just saved
                
                Application.CutCopyMode = False
            End If
        End If
    Next Sheet
    
    ' Restore default application settings
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Key Improvements Breakdown #

• Reliable Worksheet Filtering: We use For Each Sheet instead of index-based looping, and add two critical checks:
  • Skips sheets named "macro" or "report" explicitly
  • Validates that H32 contains a numeric value greater than 0 (avoids errors if H32 has text)
• Clean PasteSpecial Logic: Removed redundant calls and kept only xlPasteValues and xlPasteFormats to ensure no formulas are pasted
• Efficiency Boosts: Copies only the used range (not all cells) and disables events to speed up execution
• Safer Error Handling: Resets error handling after folder creation to catch unexpected issues later

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