Extracting specific worksheets out of multiple workbooks

I have a bunch of different workbooks saved in a folder.  All of the worksheets in in every workbook are formatted and named the same in all the workbooks.  What I need is to extract a specific worksheet from all the workbooks and combine them in into one workbook renaming the individual worksheets the first 10 characters from the cell A1.  I want to close the workbook I extracted the worksheet from without savingsaving
Jenedge73Asked:
Who is Participating?
 
Robberbaron (robr)Commented:
my adaptation of Zorvek's code for your situation

save this in a blank workbook, run the macro and it will ask to save result as a new name, so that you still have the master for next time

Option Explicit
Sub MakeMaster()
    Dim xFolder As String, xSheetName As String
    xFolder = "C:\ee\myTestFolder" ' change this directory as needed
    xSheetName = "Sheet2"
    
    UpdateMaster xFolder, xSheetName
End Sub

Sub UpdateMaster(foldername As String, sheetname As String)

   Dim SourceWorkbook As Workbook
   Dim SourceWorksheet As Worksheet
   Dim curFilename As String, newname As String
   
  'past solution refer http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_24707081.html
  'Zorvek  2008
  

   curFilename = Dir(foldername & "\*.xls")
   Do While curFilename <> ""
      
      Set SourceWorkbook = Workbooks.Open(FileName:=foldername & "\" & curFilename, ReadOnly:=True)
      
      Set SourceWorksheet = SourceWorkbook.Worksheets(sheetname)
        newname = SourceWorksheet.Range("A1").Value
        SourceWorksheet.Visible = xlSheetVisible
        SourceWorksheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

        ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = newname
         
        SourceWorkbook.Close SaveChanges:=False
        curFilename = Dir  'get next file
   Loop

End Sub

Open in new window

0
 
Robberbaron (robr)Commented:
0
 
Robberbaron (robr)Commented:
sorry bit of an edit for the <first 10 characters requirement>

      
  newname = SourceWorksheet.Range("A1").Value
        If newname = "" Then
            newname = curFilename  'ensure a value
         Else
            newname = Left(newname, 10)
        End If

Open in new window

0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
Jenedge73Author Commented:
Some problems.
1. I need to “cut” from the original and then close the original without saving.  This way the original links are maintained without changing the original file
2.  I need to specify the sheet i want to extract; it will be the same sheet name for all the workbooks in the folder
3. The renaming of the worksheet works.
0
 
Robberbaron (robr)Commented:
1.  The code currently copies the entire source sheet into the master workbook and then closes the source book without saving. I dont get what you mean by Cut....
SourceWorksheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
does the copy
 
SourceWorkbook.Close SaveChanges:=False
closes without saving

2. The only way to sepcifiy the sheet is probably by Typing its name into a textbox popup or to a cell on the masterbook 'action page' that maybe you create.  this would be done in the MakeMaster routine.  which is your preference.
0
 
Jenedge73Author Commented:
Thanks it works great
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.