Copy Sheet Into New Workbook

[Intermediate Experience User]

Can someone PLEASE advise. I can't figure this out!

I have hundreds of files in one folder. I need to open specific files
within that folder and copy a sheet named "C 2009" in that workbook into a
new workbook. I need to then close the source book without saving,
save/close the new book and move on to the next open/copy/close/close and
save sequence.

The files I have to open are in column A of a worksheet (no header) called
"SourceBook" and the name I want to save the new book as is in columb B (no
header). The sheet can be named "C 2009" as it is in the source book.

So, however many rows I have "SourceBook" should be how many files I get in
the end....each with a tab that is called "C 2009." I can save all of these
files into a folder on my desktop, or anywhere else....just all together.

Please help as this is time-sensitive.

Thank you sincerely in advance.

 

[Barb Reinhardt]

Try something like this. You'll need to change the source and result folder
locations. This is untested.

Option Explicit

Sub Test()

Dim mySourceFolder As String
Dim myResultFolder As String
Dim myFile As String
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet

mySourceFolder = "C:\Documents and
Settings\barbara.reinhardt\Desktop\SourceFolder\"
myResultFolder = "C:\Documents and
Settings\barbara.reinhardt\Desktop\ResultFolder\"

myFile = Dir(mySourceFolder & "*.x*")
If myFile = "" Then Exit Sub

Do
Set oWB = Nothing
Set oWS = Nothing
On Error Resume Next
Set oWB = Workbooks.Open(mySourceFolder & myFile)
Set oWS = oWB.Worksheets("C 2009")
On Error GoTo 0

If Not oWS Is Nothing Then
'copy worksheet
oWS.SaveAs (myResultFolder & oWB.Name)
oWB.Close savechanges:=False
End If

myFile = Dir
Loop While myFile <> ""

End Sub