How to combine these 2 different VBA codes

[MaunishP]

Hi Team,
Could you please provide a solution to club these 2 VBA codes and ensuring that workbook which is been saved in specific path with specfic format " Your Name_Ftype_TodayDate "

Here goes Code 1, which allows me to split worksheets from column A, but i will like to refer to data in Column Z to split and copy data from Column A to AE.

Sub Extract_All_Data()

    'this macro assumes that your first row of data is a header row.
    'will copy all filtered rows from one worksheet, to another blank workbook
    'each unique filtered value will be copied to it's own sheet
    'Variables used by the macro
   
    Dim wbDest As Workbook
    Dim rngFilter As Range, rngUniques As Range
    Dim cell As Range, counter As Integer
   
    ' Set the filter range (from A1 to the last used cell in column A)
    '(Note: you can change this to meet your requirements)
    Set rngFilter = Range("A1", Range("A" & Rows.Count).End(xlUp))
   
    Application.ScreenUpdating = False
   
    With rngFilter
       
        ' Filter column A to show only one of each item (uniques) in column A
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
       
        ' Set a variable to the Unique values
        Set rngUniques = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
       
        ' Clear the filter
        ActiveSheet.ShowAllData
       
    End With
   
    ' Create a new workbook with a sheet for each unique value
    Application.SheetsInNewWorkbook = rngUniques.Count
    Set wbDest = Workbooks.Add
    Application.SheetsInNewWorkbook = 3

    ' Filter, Copy, and Paste each unique to its' own sheet in the new workbook
    For Each cell In rngUniques
   
        counter = counter + 1
       
        'NOTE - this filter is on column A (field:=1), to change
        'to a different column you need to change the field number
        rngFilter.AutoFilter field:=1, Criteria1:=cell.Value
       
        ' Copy and paste the filtered data to it's unique sheet
        rngFilter.Resize(, 33).SpecialCells(xlCellTypeVisible).Copy Destination:=wbDest.Sheets(counter).Range("A1")
        ' Name the destination sheet
        wbDest.Sheets(counter).Name = cell.Value
        wbDest.Sheets(counter).Cells.Columns.AutoFit
       
    Next cell
   
    rngFilter.Parent.AutoFilterMode = False
    Application.ScreenUpdating = True
   
End Sub

Here goes Code 2

Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.path & "/" & ws.Name & _
        Format(Date, "_mmddyyyy") & ".xlsx"
        ws.Copy
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs strFilename
        wbNew.Close
    Next ws
End Sub

egards,
Maunish Patel

 

[MaunishP]

Hi all,
Can some Ninja, members or expertize intervene into this query.

Regards,
MP