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
Who is Participating?

Commented:

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

0

Commented:
0

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

0

Author 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

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

Author 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.