Solved

Extracting specific worksheets out of multiple workbooks

Posted on 2012-09-21
276 Views
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
Question by:Jenedge73

LVL 32

Expert Comment

0

LVL 32

Accepted Solution

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

LVL 32

Expert Comment

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 Comment

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

LVL 32

Expert Comment

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 Comment

Thanks it works great
0

Featured Post

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.