How can I separate tabs and advanced filter?

Viewed 23

I am trying to make a macro where I separate my tabs (one from each client) into new excel files and then also filter, copy and paste (from a sheet called database) in each of those excel files just created the informations regarding each client.

When I try to run the code, it separate the tabs just as expected, but it does not copy and paste the information from my database sheet. I got the following error: "Application-defined or object-definied error" for the line "For Each x In Workbk.Sheets(sht).Range([AA2], Cells(Rows.Count, "AA").End(xlUp))"

How can I fix it?

Sub Separar_guias()
    Dim xPath As String
    xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    End Sub
    
    
    Sub filter()
    Application.ScreenUpdating = False
    Dim x As Range
    Dim rng As Range
    Dim rng1 As Range
    Dim last As Long
    Dim sht As String
    Dim newBook As Excel.Workbook
    Dim Workbk As Excel.Workbook
    
    'Specify sheet name in which the data is stored
    sht = "database"
    
    'Workbook where VBA code resides
    Set Workbk = ThisWorkbook
    
    'change filter column in the following code
    last = Workbk.Sheets(sht).Cells(Rows.Count, "AA").End(xlUp).Row
    
    With Workbk.Sheets(sht)
    Set rng = .Range("A1:T" & last)
    End With
    
    Workbk.Sheets(sht).Range("AA1:AA" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
    
    ' Loop through unique values in column
    For Each x In Workbk.Sheets(sht).Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
    
    With rng
    .AutoFilter
    .AutoFilter Field:=27, Criteria1:=x.Value
    .SpecialCells(xlCellTypeVisible).Copy
    
    'Add New Workbook in loop
    Set newBook = Workbooks.Add(xlWBATWorksheet)
    
    newBook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
    newBook.Activate
    ActiveSheet.Paste
    End With
    
    'Save new workbook
    newBook.SaveAs x.Value & ".xlsx"
    
    'Close workbook
    newBook.Close SaveChanges:=False
    
    Next x
    
    ' Turn off filter
    Workbk.Sheets(sht).AutoFilterMode = False
    
    With Application
    .CutCopyMode = False
    .ScreenUpdating = True
    End With
    
    End Sub
0 Answers
Related