VBA to copy same sheet from multiple workbooks, paste as value in separate worksheets in new workbook

[jrg24]

This thread (replay #7 , specifically) nearly does what I want it to do with two exceptions. Code copied below for expediency (Thanks, Bertie for writing this code!)

https://www.mrexcel.com/forum/excel-questions/715760-loop-through-folder-copy-worksheet.html

This code copies a particular worksheet from every file in a directory and puts it into another workbook. This would work just fine for me except for two things.

First, the worksheets I am pulling the data from are all formulas that are compiling information from other sheets that obtain data from our archaic financial reporting system. I would like to have the data from the sheets pasted in the new workbook as values with the same formatting, if possible. keeping the formulas in tact is causing pop up issues due to the copying of the sheet is copying range names that are the same for all workbooks.

Second, I would like the new worksheet that contains the copied values to be named the first 5 characters of the file we are copying from's name. Every file I am copying is named the same thing so I wind up with a bunch of files with the same name and a numbered sequence. If this is not possible, I can create something close enough from a value in another worksheet on the file we a re copying from.

Can the code be modified to paste values and formats only, or will I need a completely different Macro? I have found other macros that copy and paste values, but it does so on the same worksheet in the new workbook. Trying to search with so many similar search terms is proving difficult. Thanks in advace for your help.

[COLOR=darkblue]Option[/COLOR][COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] test()
   [COLOR=darkblue]Dim[/COLOR] sFolder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] sFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] wbSource [COLOR=darkblue]As[/COLOR] Workbook
   [COLOR=darkblue]Dim[/COLOR] wbMaster [COLOR=darkblue]As[/COLOR] Workbook
   
   [COLOR=green]'====================================================[/COLOR]
   [COLOR=green]'EDIT THIS[/COLOR]
   sFolder = [COLOR=#ff0000]"C:\temp\" [/COLOR]   'remember trailing backslash
   [COLOR=green]'====================================================[/COLOR]
   
   [COLOR=green]'set up the master workbook[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbMaster = ThisWorkbook
   
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler   [COLOR=green]'reset application setting on error[/COLOR]
   Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
   
   [COLOR=green]'loop through all excel files in folder[/COLOR]
   sFile = Dir(sFolder & "*.xls*")
   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] sFile = ""
   
      [COLOR=green]'open the source workbook[/COLOR]
      [COLOR=darkblue]If[/COLOR] sFile <> wbMaster.Name [COLOR=darkblue]Then[/COLOR]   [COLOR=green]'don't process the master workbook[/COLOR]
         [COLOR=darkblue]Set[/COLOR] wbSource = Workbooks.Open(sFolder & sFile)
         
         [COLOR=green]'copy the first worksheet EDIT IF NECESSARY[/COLOR]
         wbSource.[COLOR=#ff0000]Worksheets(1).Copy[/COLOR] After:=wbMaster.Sheets(wbMaster.Sheets.Count)
         
         wbSource.Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
         Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      
      [COLOR=green]'get the next file[/COLOR]
      sFile = Dir()
   [COLOR=darkblue]Loop[/COLOR]
   
   [COLOR=green]'tidy up[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbSource = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wbMaster = [COLOR=darkblue]Nothing[/COLOR]
   
errHandler:
   Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]End[/COLOR][COLOR=darkblue]Sub[/COLOR]

 

[B4andafter]

I will give this a try to my first response:
- add the Bold Itallics code to your sections - You may have to adjust the Len.(.Name)-# to get the name length you want. Hope this helps.

'copy the first worksheet EDIT IF NECESSARY
wbSource.Worksheets(1).Copy.PasteSpecial xlPasteAllUsingSourceTheme After:=wbMaster.Sheets(wbMaster.Sheets.Count)

wbMaster.Sheets(wbMaster.Sheets.Count).Name = Left(strExtension, Len(.Name) - 5)

 

[B4andafter]

Sorry forgot the , behind the word Theme