Copy worksheets into new file

[rglasunow]

I am currently trying to write a macro to run a summary. I hav
numerous Excel files under a folder and I would like to have specifi
tabs copied into one workbook. Below is the code that I have tried an
is not working. Any sugestions would be great. Also would it b
possible to name the tabs off a specific cell in each worksheet?

Thanks in advance!!

Sub RyanTabCombo()

Application.ScreenUpdating = False
Dim FName As String
Dim WB As Workbook
Dim Dest As Range
Const FOLDERNAME = "C:\Excel Test\Summaries"
ChDrive FOLDERNAME
ChDir FOLDERNAME

Workbooks.Open Filename:= _
"C:\Excel Test\Ryan - Summary Template.xls"
Set Dest = Range("A1")
FName = Dir("*.xls")

Do Until FName = ""
Set WB = Workbooks.Open(FName)
WB.Worksheets("Sheet1").Move Destination:=Dest
WB.Close savechanges:=False
Set Dest = Windows("Ryan - Summary Template.xls")
FName = Dir()
Loop

MsgBox "The summary is completed. Thank you."

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Excel Test\Ryan - " & Format(Date
"mm-dd-yyyy") & ".xls"
ActiveWorkbook.Close

End Su

 

[Ron de Bruin]

Try this example
http://www.rondebruin.nl/copy3.htm

This will give you some ideas
Post back if you need more help

 

[Bernie Deitrick]

Rglasunow,

Try the macro below, modifying where indicated. Copy the code into a module
in an otherwise empty workbook.

HTH,
Bernie
MS Excel MVP

Sub ConsolidateSpecificSheet()
Dim myBook As Workbook
Dim myCalc As XlCalculation
Dim myShtName As String

myShtName = "SheetName" ' Enter specific Sheetname

With Application
.EnableEvents = False
.DisplayAlerts = False
myCalc = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\Excel"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
Worksheets(myShtName).Select
Worksheets(myShtName).Name = _
Replace(ActiveWorkbook.Name, ".xls", "")
ActiveWindow.SelectedSheets.Move _
After:=ThisWorkbook.Sheets(1)
myBook.Close False
Next i
Else: MsgBox "There were no files found."
End If
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
.Calculation = myCalc
End With

End Sub

 

[rglasunow]

Thanks to you both. Both ways worked. However, I want it to save th
tabs into a new workbook outside the one the macro is running in. I'v
been trying different varities to the code and I can't get it to creat
a new file to save the tabs into.

Also do you know if it is possible to name each tab to a cell in eac
tab?

Thank you very much

 

[Bernie Deitrick]

To add the sheets to a new file, add this to the code:

Dim myNewBook As Workbook
Set myNewBook = Workbooks.Add

and then change

ActiveWindow.SelectedSheets.Move _
After:=ThisWorkbook.Sheets(1)
to
ActiveWindow.SelectedSheets.Move _
After:=myNewBook.Sheets(1)

To rename the sheet to a value on the sheet itself (say, in cell A2) change

Worksheets(myShtName).Name = _
Replace(ActiveWorkbook.Name, ".xls", "")
to
Worksheets(myShtName).Name = _
Worksheets(myShtName).Range("A2").Value

HTH,
Bernie
MS Excel MVP

 

[rglasunow]

Thank you very much. This worked perfectly!! Have a great day

 

[rglasunow]

Is there anything that this code could be doing that would bring over o
create an embedded object? I am not able to save the file when I a
done and I get a message when I try to save it saying, "Document No
Saved."

I've manually copied the tab into a new file and saved it and it work
fine.

Any ideas?

Thanks

 

[Bernie Deitrick]

Not that I can think of. I have never had this particular procedure fail in
any way, so the only things I can think of:

- If one or more of the sheets that gets copied has an embedded object,
then that would get copied as well.
You could delete any objects through code....
- If there are links, perhaps they get screwed up....
You could convert everything to values, perhaps.
- If there are named ranges, maybe they conflict...
Delete all named ranges through code.
-....?

Sorry that I can't be of more help...
Bernie
MS Excel MVP