Excel VBA：用通配符避免分类汇总行被过滤及复制异常

Alright, let's break down your Excel VBA issues and fix them one by one—these are all super common headaches when splitting filtered data into separate sheets. Here's what you need to do:

VBA uses the Like operator for pattern matching, which lets you use wildcards like * (matches any number of characters). To skip any sheet whose name starts with "Sheet", add this check to your loop:

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    ' Skip sheets starting with "Sheet" (works for Sheet1, Sheet2, SheetXYZ, etc.)
    If ws.Name Like "Sheet*" Then
        GoTo NextSheet ' Use "Continue For" if you're on Excel 2010+
    End If

    ' Your existing code to filter/copy data goes here

NextSheet:
Next ws

The Like "Sheet*" pattern will catch any sheet name that starts with "Sheet", no matter what characters come after it.

The problem here is likely your code is excluding subtotal rows (either by filtering them out or skipping hidden outline rows). Here are two fixes depending on your workflow:

Option A: Explicitly Include Subtotal Rows #

If you're looping through rows to filter, check if a row is a subtotal using the Subtotal property, then include it in your copy:

Dim lastRow As Long, i As Long
Dim newSheet As Worksheet
Set newSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
newSheet.Name = "FilteredData"

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 2 To lastRow ' Skip header row
    ' Check if this is a subtotal row OR matches your salesperson filter
    If ws.Rows(i).Subtotal = True Or ws.Cells(i, "SalespersonColumn").Value = "TargetName" Then
        ws.Rows(i).Copy Destination:=newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Offset(1)
    End If
Next i

Option B: Unhide Subtotal Rows Before Copying Visible Cells #

If you're using SpecialCells(xlCellTypeVisible) to copy filtered data, unhide all outline levels first to include subtotals:

' Unhide all subtotal/outline rows
ws.Outline.ShowLevels RowLevels:=2 ' Adjust the level to match your outline depth

' Copy visible rows (now includes subtotals)
ws.Range("A1:Z" & lastRow).SpecialCells(xlCellTypeVisible).Copy _
    Destination:=newSheet.Range("A1")

Large file sizes usually come from redundant data, leftover formats, or inefficient copying. Try these optimizations:

Use Arrays Instead of Row-by-Row Copying #

Row-by-row copying is slow and bloats files. Load data into an array, filter it, then write it to the new sheet:

Dim dataArr As Variant, targetArr As Variant
Dim rowCount As Long, colCount As Long, targetRow As Long
Dim i As Long, j As Long

' Load all data into an array
dataArr = ws.Range("A1:Z" & lastRow).Value
rowCount = UBound(dataArr, 1)
colCount = UBound(dataArr, 2)

' Resize target array to hold filtered data
ReDim targetArr(1 To rowCount, 1 To colCount)
targetRow = 1

' Filter data in the array
For i = 1 To rowCount
    If ws.Rows(i).Subtotal = True Or dataArr(i, "SalespersonColumnIndex") = "TargetName" Then
        For j = 1 To colCount
            targetArr(targetRow, j) = dataArr(i, j)
        Next j
        targetRow = targetRow + 1
    End If
Next i

' Write filtered data to new sheet
If targetRow > 1 Then
    newSheet.Range("A1").Resize(targetRow - 1, colCount).Value = targetArr
End If

Clean Up Redundant Content #

After creating the new sheet, delete empty rows/columns and clear unnecessary formats:

' Delete empty rows below your data
newSheet.Range(newSheet.Cells(targetRow, 1), newSheet.Cells(newSheet.Rows.Count, 1)).EntireRow.Delete

' Delete empty columns to the right of your data
newSheet.Range(newSheet.Cells(1, colCount + 1), newSheet.Cells(1, newSheet.Columns.Count)).EntireColumn.Delete

' Clear unused formats (optional, if you don't need them)
newSheet.Cells.ClearFormats

Save in a Modern Format #

Save your file as .xlsm (for macro-enabled workbooks) instead of .xls—the newer format is compressed and will reduce file size significantly.

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