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

• Sᴀᴍ Onᴇᴌᴀ: Welcome to Code Review! If this is another unregistered account of yours and you would like your reputation to accumulate on a single account then signup and then use the contact SE page to request the accounts be merged.

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

• Sorab: thanks the code and explanation ... quick follow up question. The copy paste part I need it to be exactly paste formats followed by paste values and number formats. Reason is excel is pulling up numbers from an external source with formulas and thats the only way to ensure values are copied and pasted properly. How would I incorporate that into this part of the code? dws.UsedRange.Value = dws.UsedRange.Value