Iteratively paste values from spreadsheet tabs into empty spreadsheet

Question

Basically below code is taking first 7 tabs from my current sheet and pasting them as values in a blank excel sheet with same tab names and saving them in a specific folder by filename I specified. Then doing same thing for next 7 tabs and so on. It does this 5 times in total then returns to original file and unhighlights all tabs and places curser on A1 in first tab. I'm looking to trim this code.

Sub copysheets()


    Sheets(Array("Commercial-all", "Commercial-Corp", "Commercial-HS Admin", _
        "Commercial-APAC", "Commercial-EMEA", "Commercial-LAM", "Commercial-H1")).Select
    Sheets("Commercial-APAC").Activate
    Cells.Select
    Selection.Copy
    Workbooks.Add
    yolo = ActiveWorkbook.Name
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    Application.CutCopyMode = False
    Workbooks(yolo).Activate
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Commercial-all"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Commercial-Corp"
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Commercial-HS Admin"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Commercial-APAC"
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "Commercial-EMEA"
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "Commercial-LAM"
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "Commercial-H1"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Documents\GSF\Monthly extract\commercial P&L FY23 Mon.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    
'repeat
    Sheets(Array("Finance-all", "Finance-Corp", "Finance-HS Admin", _
        "Finance-APAC", "Finance-EMEA", "Finance-LAM", "Finance-H1")).Select
    Sheets("Finance-APAC").Activate
    Cells.Select
    Selection.Copy
    Workbooks.Add
    yolo = ActiveWorkbook.Name
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    Application.CutCopyMode = False
    Workbooks(yolo).Activate
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Finance-all"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Finance-Corp"
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Finance-HS Admin"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Finance-APAC"
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "Finance-EMEA"
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "Finance-LAM"
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "Finance-H1"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Documents\GSF\Monthly extract\Finance P&L FY23 Mon.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    
'repeat
        Sheets(Array("HR-all", "HR-Corp", "HR-HS Admin", _
        "HR-APAC", "HR-EMEA", "HR-LAM", "HR-H1")).Select
    Sheets("HR-APAC").Activate
    Cells.Select
    Selection.Copy
    Workbooks.Add
    yolo = ActiveWorkbook.Name
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    Application.CutCopyMode = False
    Workbooks(yolo).Activate
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "HR-all"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "HR-Corp"
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "HR-HS Admin"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "HR-APAC"
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "HR-EMEA"
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "HR-LAM"
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "HR-H1"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Documents\GSF\Monthly extract\HR P&L FY23 Mon.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
  
'repeat

        Sheets(Array("IT-all", "IT-Corp", "IT-HS Admin", _
        "IT-APAC", "IT-EMEA", "IT-LAM", "IT-H1")).Select
    Sheets("IT-APAC").Activate
    Cells.Select
    Selection.Copy
    Workbooks.Add
    yolo = ActiveWorkbook.Name
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    Application.CutCopyMode = False
    Workbooks(yolo).Activate
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "IT-all"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "IT-Corp"
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "IT-HS Admin"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "IT-APAC"
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "IT-EMEA"
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "IT-LAM"
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "IT-H1"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Documents\GSF\Monthly extract\IT P&L FY23 Mon.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    
'repeat

    Sheets(Array("Legal-all", "Legal-Corp", "Legal-HS Admin", _
        "Legal-APAC", "Legal-EMEA", "Legal-LAM", "Legal-H1")).Select
    Sheets("Legal-APAC").Activate
    Cells.Select
    Selection.Copy
    Workbooks.Add
    yolo = ActiveWorkbook.Name
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Sheet1").Select
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    Application.CutCopyMode = False
    Workbooks(yolo).Activate
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Legal-all"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Legal-Corp"
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Legal-HS Admin"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Legal-APAC"
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "Legal-EMEA"
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "Legal-LAM"
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "Legal-H1"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Documents\GSF\Monthly extract\Legal P&L FY23 Mon.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    
'go back to support function P&L
    Windows("Support Function P&L Details FY23-Update File.xlsm").Activate
    Sheets("Copy button").Activate
End Sub

Answer 1

Copy Series of Sheets To New Workbooks

Option Explicit
' Use 'Option Explicit' which will force you to declare all variables
' but will benefit you on multiple accounts e.g. by detecting typos
' at compile-time (before running the code (run-time)).
' Use variables to make the code more readable e.g. to avoid unecessary
' repeating code and long unreadable lines.

Sub ExtractMonthly() ' Use a more appropriate name for the procedure.
    
    ' Define constants.
    
    ' Use constants at the beginning of the code so you can easily modify
    ' them instead of looking for them scattered in the code.
    Const PROC_TITLE As String = "Extract Monthly"
    Const SRC_NAME As String = "Copy Button"
    Const SRC_FINAL_CELL As String = "A1"
    Const DST_PARENT_FOLDER_PATH As String = "C:\Users\"
    Const DST_SUBFOLDER_PATH As String = "Documents\GSF\Monthly extract\"
    Const DST_FILE_NAME_SUFFIX As String = " P&L FY23 Mon"
    Const psDelimiter As String = "-"
    
    ' Use arrays so you can easily combine data by using a loop.
    Dim Prefixes(): Prefixes = VBA.Array( _
        "Commercial", "Finance", "HR", "IT", "Legal")
    Dim Suffixes(): Suffixes = VBA.Array( _
        "all", "Corp", "HS Admin", "APAC", "EMEA", "LAM", "H1")
    ' The 'VBA.' preceding 'Array' will ensure a zero-based array
    ' ('Option Base'-related).
    
    ' Determine the Destination path.
    
    Dim pSep As String: pSep = Application.PathSeparator
    
    ' Check the path separators.
    Dim dpPath As String: dpPath = DST_PARENT_FOLDER_PATH
    If Right(dpPath, 1) <> pSep Then dpPath = dpPath & pSep
    Dim dsPath As String: dsPath = DST_SUBFOLDER_PATH
    If Left(dsPath, 1) = pSep Then dsPath = Right(dsPath, Len(dsPath) - 1)
    If Right(dsPath, 1) <> pSep Then dsPath = dsPath & pSep
    Dim dPath As String: dPath = dpPath & dsPath
    
    ' Usually, the 'Documents' folder is located in one of the following
    ' two locations: 'Environ("USERPROFILE")' or 'Environ("OneDrive")'.
    If Len(Dir(dPath, vbDirectory)) = 0 Then
        dPath = Environ("USERPROFILE") & pSep & DST_SUBFOLDER_PATH
        If Len(Dir(dPath, vbDirectory)) = 0 Then
            dPath = Environ("OneDrive") & pSep & DST_SUBFOLDER_PATH
            If Len(Dir(dPath, vbDirectory)) = 0 Then
                MsgBox "Could not find the destination path.", _
                    vbCritical, PROC_TITLE
                Exit Sub
            End If
        End If
    End If
    
    ' Prepare the rest for the loop.
    
    ' Retrieve the upper limits of the given arrays.
    Dim pUpper As Long: pUpper = UBound(Prefixes)
    Dim sUpper As Long: sUpper = UBound(Suffixes)
    ' Define the SheetNames array.
    Dim SheetNames() As String: ReDim SheetNames(0 To sUpper)
    ' Reference the Source workbook.
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    ' Only if the code is not in the source workbook, use:
    'Set swb = Workbooks("Support Function P&L Details FY23-Update File.xlsm")
    ' The benefit of using 'ThisWorkbook' is that you can use this code
    ' in any workbook and if you rename the workbook, the code will still work.
    
    ' Right before the loop, is often the best place to turn off screen updating
    ' which may or may not increase efficiency but will certainly prevent
    ' screen flickering especially in this case with all
    ' the 'copy-to-new-workbook' activity.

    Application.ScreenUpdating = False
    
    ' Declare variables to be used in the loop.
    Dim dwb As Workbook, dws As Worksheet
    Dim p As Long, s As Long, Prefix As String, dBaseName As String
    
    ' The Loop
    
    For p = 0 To pUpper
        
        ' Write the sheet names to the array.
        
        Prefix = Prefixes(p)
        
        For s = 0 To sUpper
            SheetNames(s) = Prefix & psDelimiter & Suffixes(s)
        Next s
        ' When using an array of sheet names to copy sheets to a new workbook
        ' in one go, the sheets are copied in the order as they appear
        ' in the workbook, which is not necessarily the order in the array.
        ' At least one of the sheets needs to be visible. Hidden sheets
        ' will be copied hidden while very hidden sheets will be skipped
        ' without warning.
        
        ' Copy the sheets to a new workbook, convert to values,
        ' save and close the new workbook.
        
        swb.Sheets(SheetNames).Copy
        Set dwb = Workbooks(Workbooks.Count)
        For Each dws In dwb.Worksheets
            ' Convert to values while preserving formatting.
            dws.UsedRange.Value = dws.UsedRange.Value
        Next dws
        ' When saving a never saved workbook, it will by default be saved
        ' as a macro-free workbook ('.xlsx'), so there is no need
        ' for the file extension nor the 'FileFormat' parameter.
        dBaseName = dPath & Prefix & DST_FILE_NAME_SUFFIX
        ' Disable alerts to remove any code from the object modules,
        ' and to overwrite an existing file, both without confirmation.
        Application.DisplayAlerts = False
            dwb.SaveAs dBaseName
        Application.DisplayAlerts = True
        dwb.Close SaveChanges:=False ' it just got saved
        
    Next p ' next prefix, next 's' number of worksheets, next workbook

    ' Finishing Touches

    ' You don't want to activate or select anything unless necessary
    ' because it messes up the selection and severly slows down the code.
    ' If you run this code from a button on the 'Copy Button' sheet,
    ' since you have closed all newly created workbooks, most likely
    ' the 'Copy Button' worksheet will be the active (selected) one.
    ' Just in case it isn't (when running the code while another workbook
    ' or worksheet is active), you can use the following:
    If Not swb Is ActiveWorkbook Then swb.Activate
    Dim sws As Worksheet: Set sws = swb.Sheets(SRC_NAME)
    Application.Goto sws.Range(SRC_FINAL_CELL) ' sheet selection included
    ' i.e. you need to make sure the correct workbook is active to select
    ' a sheet in it, and you need to make sure that the correct worksheet
    ' is selected (active) to select a cell (range) in it. For the latter,
    ' alternatively, you can use `Application.Goto`.
    
    ' Right before the message box showing, is often the best place
    ' to turn screen updating back on so you can already see any changes
    ' while the message box is showing. Of course, in this case, you will
    ' just be seeing the 'Copy Button' worksheet but it's good practice.
    Application.ScreenUpdating = True
    
    ' Using a message box at the end of the code is also good practice
    ' so you know the code has run especially when the code would
    ' do harm when running again. In this case, if you would accidentally
    ' run the code again, it would just overwrite the previously created files
    ' with the same files but would waste your precious time.
    MsgBox "Monthly data extracted.", vbInformation, PROC_TITLE
    
End Sub