• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 320
  • Last Modified:

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
0
Jenedge73
Asked:
Jenedge73
  • 4
  • 2
1 Solution
 
Robberbaron (robr)Commented:
0
 
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:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
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

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now