多Sheet页Excel表,使用VBA按列筛选并分别导出到Excel

Sub 按分公司生成销售月报()


  '月报保存目录,默认当前路径
  Dim savePath As String
  savePath = ThisWorkbook.Path
  
 
  '在Sheet页"定义名称"中取分公司名称
  Dim BcArray() As Variant
  BcArray = ThisWorkbook.Sheets("定义名称").Range("A1:A20").Value
  
       
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
    
    Dim Wb As Workbook
    Dim company As Variant
    
    '循环每个分公司的名字
    For i = 1 To UBound(BcArray, 1)
     company = BcArray(i, 1)
     Set Wb = Workbooks.Add
     '汇总页设置下拉框的值,统计数据跟着刷新,并Copy到新的工作簿的最后Sheet页
     ThisWorkbook.Sheets("汇总").Range("B1") = company
     ThisWorkbook.Sheets("汇总").Copy After:=Wb.Sheets(Wb.Sheets.Count)
    '设置过滤条件,按第一列过滤,条件是分公司名称
    ThisWorkbook.Sheets("定义名称").UsedRange.AutoFilter Field:=1, Criteria1:=company
    ThisWorkbook.Sheets("一级分类").UsedRange.AutoFilter Field:=1, Criteria1:=company
    ThisWorkbook.Sheets("二级分类").UsedRange.AutoFilter Field:=1, Criteria1:=company
    ThisWorkbook.Sheets("三级分类").UsedRange.AutoFilter Field:=1, Criteria1:=company
    
   '过滤后实际上是把满足条件的显示，不满足条件的隐藏了，所以可以全选->拷贝->添加Sheet页（默认激活）->设置名称并黏贴数据
    ThisWorkbook.Sheets("定义名称").Activate
    ActiveSheet.Cells.Select
    Selection.Copy
    Wb.Sheets.Add After:=Wb.Sheets(Wb.Sheets.Count)
    Wb.ActiveSheet.Name = "定义名称"
    Wb.ActiveSheet.Paste
      
     
   ThisWorkbook.Sheets("一级分类").Activate
    ActiveSheet.Cells.Select
    Selection.Copy
    Wb.Sheets.Add After:=Wb.Sheets(Wb.Sheets.Count)
    Wb.ActiveSheet.Name = "一级分类"
    Wb.ActiveSheet.Paste
    
    ThisWorkbook.Sheets("二级分类").Activate
    ActiveSheet.Cells.Select
    Selection.Copy
    Wb.Sheets.Add After:=Wb.Sheets(Wb.Sheets.Count)
    Wb.ActiveSheet.Name = "二级分类"
    Wb.ActiveSheet.Paste
    
    ThisWorkbook.Sheets("三级分类").Activate
    ActiveSheet.Cells.Select
    Selection.Copy
    Wb.Sheets.Add After:=Wb.Sheets(Wb.Sheets.Count)
    Wb.ActiveSheet.Name = "三级分类"
    Wb.ActiveSheet.Paste
     
    
    '在Excel2010里默认有这三个Sheet页,在Excel2016里没有,请根据自己的情况选择是否打开语句
    'Wb.Sheets("Sheet1").Delete
    'Wb.Sheets("Sheet2").Delete
    'Wb.Sheets("Sheet3").Delete
      
    '激活汇总页,并删除汇总页的下拉框,这步很重要
    Wb.Sheets("汇总").Activate
    Wb.Sheets("汇总").Range("B1").Validation.Delete
    
    '保存文件
    Wb.SaveAs savePath + "\" + company + ".xlsx"
 
    Wb.Close True
        
  
  
    Next
     
   Application.DisplayAlerts = False
   Application.ScreenUpdating = True

End Sub