Copy workbooks to new folder and delete some worksheets

[camandab]

Hello,

I need to copy all workbooks in a folder (call it C:\2009) to a new folder (C:\2010). Each workbook contains at least 1 worksheet for each month of the year so I need to delete all worksheets except the Dec 09 worksheet(s). (The worksheet names will not always be the same from workbook to workbook so I need to delete the sheets that do not contain "Dec" and "09".) Then I'll need to make a copy of the first sheet, rename it to 'Jan 10', save, close, and do the same thing for each workbook in the new folder.

I haven't been able to create a code that will execute everything I need to do.

Help please!! Thanks!

 

[jbeaucaire]

This should do it. There's no error checking on those sheet names, so hopefully you are correct and there is at least one sheet in each workbook with a name with "Dec" and "09" in it.

Option Explicit
Option Compare Text

Sub CopyFiles()
'JBeaucaire  (2/16/2010)
'Copy all files in C:\2009 into C:\2010
'Open each new file, delete all sheets except 'Dec 09'
'Copy that sheet to Jan 10
Dim fName As String, oldDir As String
Dim fOUT As String, ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

oldDir = CurDir         'memorizes the users current working path
ChDir "C:\2009\"        'path with old files
fOUT = "C:\2010\"       'path to new files destination

fName = Dir("*.xls")    'start a list of filenames

Do While Len(fName) > 0     'copy each file from old folder to new one
    FileCopy fName, fOUT & fName
    fName = Dir
Loop

ChDir fOUT              'switch to new folder

fName = Dir("*.xls")    'start a list of filenames

Do While Len(fName) > 0     'open each file and make sheet changes
    Workbooks.Open (fName)
    For Each ws In Worksheets   'Delete files with wrong name
        If Not ws.Name Like "*Dec*" Or Not ws.Name Like "*09" Then ws.Delete
    Next ws
    ActiveSheet.Copy After:=Sheets(1)   'Copy remaining sheet
    ActiveSheet.Name = "Jan 10"         'Rename new sheet
    ActiveWorkbook.Close True           'Close and save workbok
    fName = Dir                         'ready next filename
Loop

ChDir = oldDir          'Restore original working directory
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[camandab]

Thanks for the quick reply!

I'm getting the following error message on the ChDir = oldDir line:

"Compile error: Argument not optional "

I'm not sure what to do to correct this.

 

[jbeaucaire]

Sorry... remove the equal sign.