VBA遍历工作表应用日期筛选异常：仅处理首个工作表

问题原因 #

原代码仅能处理第一个工作表的核心问题在于目标复制区域固定不变：

• 你把DRng固定设置为DestSh.Range("A3")，第一次处理USD工作表时，筛选数据会写入A3开始的区域；
• 处理第二个EUR工作表时，AdvancedFilter会直接覆盖A3开始的已有数据，导致看起来EUR的数据没被处理。

修改后的代码 #

Sub SheetLoop()
    Dim Ws As Worksheet
    Dim wb As Workbook
    Dim DestSh As Worksheet
    Dim Rng As Range
    Dim CRng As Range
    Dim DRng As Range

    Set wb = ThisWorkbook
    Set DestSh = wb.Worksheets("Report")
    Set CRng = DestSh.Range("L1").CurrentRegion
    
    ' 可选：清除Report工作表旧数据（保留表头的话从A3开始清）
    ' DestSh.Range("A3:Z" & DestSh.Rows.Count).ClearContents
    
    ' 初始化目标区域为A3
    Set DRng = DestSh.Range("A3")

    For Each Ws In wb.Worksheets
        If Ws.Name <> DestSh.Name Then
            Set Rng = Ws.Range("A1").CurrentRegion
            
            ' 执行高级筛选
            Rng.AdvancedFilter xlFilterCopy, CRng, DRng
            
            ' 更新目标区域到下一个空白行，避免覆盖已有数据
            Set DRng = DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Offset(1)
        End If
    Next Ws
End Sub

关键修改点 #

• 动态更新目标区域：每次执行完AdvancedFilter后，通过DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Offset(1)找到A列最后一行的下一个空行，将DRng指向这个位置，确保后续工作表的筛选数据追加在已有数据下方。
• 可选旧数据清除：如果需要每次运行都清空之前的报告数据，可以取消注释代码里的清除行，避免新旧数据混杂。

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