Macro Update - Save worksheets from 2 workbooks into new file (instead of from 1 workbook)

Hi folks,

JBeaucaire kindly drafted me the macro below which saves worksheets from Workbook1 provided they had certain criteria in Cell G1. (Criteria being the details in column A of worksheet "Menu")

I'm currently having a slight issue with the file being very large with so many tabs and I was wondering if it would be possible to copy tabs from Workbook1 & Workbook2 (instead of having all tabs in 1 worksheet) provided they had certain criteria in Cell G1. (Criteria being the details in column A of worksheet "Menu")

Basically I'm trying to get the following:

If the tab "Menu" of Worksheet1 has a list of names = "Jim", "Mark", etc. in column A of "Menu" tab of Workbook1, the macro copies all tabs from Worksheet1 & Worksheet2 (that contain "Jim" in Cell G1) into a new Workbook, then copies all tabs from Workbook1 & Workbook2 (that contain "Mark" in Cell G1) into a new Workbook...

Many thanks for the help guys!


https://www.excelforum.com/excel-pro...-criteria.html

Option Explicit

Sub CreateWBsByName()
Dim fPATH As String, Nm As Range, wbNEW As Workbook, ws As Worksheet, CNT As Long

fPATH = "C:\Path\To\Save\New\Files\"        'remember the final \ in this path string

Application.DisplayAlerts = False           'no alerts, will overwrite existing files
Application.ScreenUpdating = False          'speed up macro

For Each Nm In ThisWorkbook.Sheets("Menu").Range("A:A").SpecialCells(xlConstants)   'each name in the MENU
    For Each ws In ThisWorkbook.Sheets                              'one sheet at at time
        If ws.Range("G1").Value = Nm.Value Then                     'check each ws G1 cell
            If wbNEW Is Nothing Then                                'create a new workbook is needed
                ws.Copy
                Set wbNEW = ActiveWorkbook
            Else                                                    '...or copy into existing new workbook
                ws.Copy After:=wbNEW.Sheets(wbNEW.Sheets.Count)
            End If
            With ActiveSheet
                .UsedRange.Value = .UsedRange.Value
            End With
        End If
    Next ws
    If Not wbNEW Is Nothing Then                                    'if wbNEW exists then save it and close
        wbNEW.SaveAs fPATH & Nm.Value & ".xlsx", 51
        wbNEW.Close
        CNT = CNT + 1                                               'count how many new workbooks are saved
        Set wbNEW = Nothing
    End If
Next Nm
Application.ScreenUpdating = True                                   'reset the screen
MsgBox "Done, a total of " & CNT & " workbooks were created"
End Sub