Copy sheets between workbokks in VBA

tombrown

Board Regular
Joined
Jun 2, 2006
Messages
50
How do I copy sheets between workbooks in VBA?

I want to copy a number of individual sheest from wbCurrent to wbNew (both declared as workbooks) I tried this ... but it didnt work

wbCurrent.Sheets("PCO Mth").Copy wbNew

thanks
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071
Hi,
Your argument (wbNew) needs to specify not just the workbook you want to copy it to, but the sheet you want to copy it before or after. (Before is the default, but it's usually easier to read if you name the argument.)
Code:
wbCurrent.Sheets("PCO Mth").Copy Before:=wbNew.Sheets(1)
 

tombrown

Board Regular
Joined
Jun 2, 2006
Messages
50
Thanks - this worked,

but now I have another issue.

Some of the sheets in the original workbook include formulas &/or charts based on data in other sheets in the same workbook. I want to copy them all across, but I want to formulae and charts to reference the copied sheets in the new workbook .... at the moment they refer back to the original sheet. Is there an argument to achieve this?
 

tombrown

Board Regular
Joined
Jun 2, 2006
Messages
50
Another possibility would be to use SaveAs method, but I woudl like to remove all the VBA modules and some of the sheets when the file is saved ... how can I do that?
 

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071

ADVERTISEMENT

Hmmm, probably the easiest way to do that would be to just clone your workbook. I have some code from an add-in I built a while back that might be helpful to you. but it will leave teh VBA modules in. I will post back in with cod eto strip the VBA modules.<hr>
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> BackupWorkBook()
<SPAN style="color:#007F00">'This code was originally written by Aaron Bush 2006</SPAN>
<SPAN style="color:#007F00">'It is not to be altered or distributed,</SPAN>
<SPAN style="color:#007F00">'except as part of an application.</SPAN>
<SPAN style="color:#007F00">'You are free to use it in any application,</SPAN>
<SPAN style="color:#007F00">'provided the copywrite notice is left unchanged.</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Code Courtesy of</SPAN>
<SPAN style="color:#007F00">'Aaron Bush</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Copywrite verbage courtesy of Dev Ashish</SPAN>
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
<SPAN style="color:#00007F">Dim</SPAN> fso <SPAN style="color:#00007F">As</SPAN> Scripting.FileSystemObject   <SPAN style="color:#007F00">'Requires reference to Microsoft Scripting Runtime</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> strFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>               <SPAN style="color:#007F00">'Holds the File name.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> bytMsgBox <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>                   <SPAN style="color:#007F00">'Holds the users response to message boxes.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> boolGotFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>          <SPAN style="color:#007F00">'Determines</SPAN>
<SPAN style="color:#00007F">Set</SPAN> fso = <SPAN style="color:#00007F">New</SPAN> Scripting.FileSystemObject
<SPAN style="color:#00007F">Do</SPAN>
    strFileName = Excel.Application.GetSaveAsFilename(ThisWorkbook.Name, "Microsoft Excel Workbook (*.xls),*.xls", Title:="Select location to copy current workbook to:")
    <SPAN style="color:#00007F">If</SPAN> strFileName = "False" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">If</SPAN> strFileName = ThisWorkbook.FullName <SPAN style="color:#00007F">Then</SPAN>
        boolGotFileName = <SPAN style="color:#00007F">False</SPAN>
        MsgBox "Cannot copy a file to the same location as itself.", vbExclamation, "Invalid Location"
        <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#00007F">If</SPAN> fso.FileExists(strFileName) <SPAN style="color:#00007F">Then</SPAN>
            bytMsgBox = MsgBox("A file already exists in that location, do you wish to overwrite it?", vbQuestion + vbYesNoCancel, "Confirm Overwrite")
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> bytMsgBox
                <SPAN style="color:#00007F">Case</SPAN> vbCancel
                    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> vbNo
                    boolGotFileName = <SPAN style="color:#00007F">False</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> vbYes
                    boolGotFileName = <SPAN style="color:#00007F">True</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
                    MsgBox "Unexpected response. Operation aborted.", vbExclamation, "Invalid Response"
                    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
            <SPAN style="color:#00007F">Else</SPAN>
            boolGotFileName = <SPAN style="color:#00007F">True</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">Until</SPAN> boolGotFileName
ThisWorkbook.Save
fso.CopyFile ThisWorkbook.FullName, strFileName, <SPAN style="color:#00007F">True</SPAN>
MsgBox "Backup complete.", vbInformation, "File Copied"
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
Err_Hnd:
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 

tombrown

Board Regular
Joined
Jun 2, 2006
Messages
50
Looks good - I am eagerly anticipating the code to strip out the modules ... many thanks.

Only caveat is that I dont want to save the original file, only the cloned version, so shoudl I leave out the ThisWorkbook.Save?

[Reason is that I have a template work book with the VBA and chart templates included. The code pulls in data from various sources and formats it into the charts. I then want to save off a copy & return the template workbook to its original data-less state]
 

Oorang

Well-known Member
Joined
Mar 4, 2005
Messages
2,071
Ok here is a version more directed to your task. I have break tested it as much as I could, but I would advise doing a little testing of your own before you release it into "the wild". Run the "CleanBackup" sub.
note: You may have to change your security settings to allow trusted access to the vba project.<hr>
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>
<SPAN style="color:#00007F">Const</SPAN> strFalse <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "False"      <SPAN style="color:#007F00">'String version of false</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> CleanBackUp()
<SPAN style="color:#00007F">Dim</SPAN> strFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>       <SPAN style="color:#007F00">'Holds the name of the file you want to make a copy of.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> strNewFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>    <SPAN style="color:#007F00">'Holds the name of the copy you intend to create.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> wbCopy <SPAN style="color:#00007F">As</SPAN> Excel.Workbook    <SPAN style="color:#007F00">'The Workbook object of the copy you inted to make.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> strFlExt <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>          <SPAN style="color:#007F00">'Holds the extension of the file to be backed up.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> bytMsgBox <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>           <SPAN style="color:#007F00">'Hold the users response to message boxes.</SPAN>
<SPAN style="color:#007F00">'This code was originally written by Aaron Bush 2006</SPAN>
<SPAN style="color:#007F00">'It is not to be altered or distributed,</SPAN>
<SPAN style="color:#007F00">'except as part of an application.</SPAN>
<SPAN style="color:#007F00">'You are free to use it in any application,</SPAN>
<SPAN style="color:#007F00">'provided the copywrite notice is left unchanged.</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Code Courtesy of</SPAN>
<SPAN style="color:#007F00">'Aaron Bush</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Copywrite verbage courtesy of Dev Ashish</SPAN>
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
<SPAN style="color:#007F00">'Get name of file to be backed up.</SPAN>
strFileName = Application.GetOpenFilename(Title:="Select file to backup:")
<SPAN style="color:#00007F">If</SPAN> strFileName = strFalse <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#007F00">'Check to see if workbook selected is opened:</SPAN>
<SPAN style="color:#00007F">If</SPAN> WorkBookOpened(strFileName) <SPAN style="color:#00007F">Then</SPAN>
    <SPAN style="color:#007F00">'If it is open then save it so no changes are lost.</SPAN>
    bytMsgBox = MsgBox("The workbook you have selected is still open. Do you wish to save it so the most recent version will be backed up?", vbQuestion + vbYesNoCancel, "Workbook Open")
    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> bytMsgBox
        <SPAN style="color:#00007F">Case</SPAN> vbYes
            Excel.Application.Workbooks(Mid$(strFileName, InStrRev(strFileName, "\") + 1)).Save
        <SPAN style="color:#00007F">Case</SPAN> vbNo: <SPAN style="color:#007F00">'Do nothing</SPAN>
        <SPAN style="color:#00007F">Case</SPAN> vbCancel: <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
            MsgBox "Unexpected response. Operation aborted.", vbExclamation, "Invalid Response"
            <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#007F00">'Get file extention of filename. This will allow us to set the filter to the same extention. Thereby allowing us</SPAN>
<SPAN style="color:#007F00">'to force the same filetype.</SPAN>
strFlExt = VBA.Right$(strFileName, 3)
<SPAN style="color:#007F00">'Get the name of the copy you intend to create.</SPAN>
strNewFileName = Application.GetSaveAsFilename(FileFilter:=", *." & strFlExt, Title:="Select new file name:")
<SPAN style="color:#00007F">If</SPAN> strNewFileName = strFalse <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#007F00">'Create a copy of the target workbook.</SPAN>
<SPAN style="color:#00007F">If</SPAN> BackupWorkBook(strFileName, strNewFileName, <SPAN style="color:#00007F">False</SPAN>) = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN>
    MsgBox "Backup Failed", vbExclamation, "Operation Aborted"
    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#007F00">'Open copy</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">Set</SPAN> wbCopy = Excel.Application.Workbooks.Open(strNewFileName)
Excel.Windows(wbCopy.Name).Visible = <SPAN style="color:#00007F">False</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#007F00">'Sub VBA from copy</SPAN>
StripVBA wbCopy, <SPAN style="color:#00007F">False</SPAN>
wbCopy.Close savechanges:=<SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
Err_Hnd:
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Function</SPAN> BackupWorkBook(<SPAN style="color:#00007F">ByVal</SPAN> strFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> strNewFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, _
Optional <SPAN style="color:#00007F">ByVal</SPAN> boolSilent <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN> = <SPAN style="color:#00007F">False</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>
<SPAN style="color:#007F00">'This code was originally written by Aaron Bush 2006</SPAN>
<SPAN style="color:#007F00">'It is not to be altered or distributed,</SPAN>
<SPAN style="color:#007F00">'except as part of an application.</SPAN>
<SPAN style="color:#007F00">'You are free to use it in any application,</SPAN>
<SPAN style="color:#007F00">'provided the copywrite notice is left unchanged.</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Code Courtesy of</SPAN>
<SPAN style="color:#007F00">'Aaron Bush</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Copywrite verbage courtesy of Dev Ashish</SPAN>
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
<SPAN style="color:#00007F">Dim</SPAN> fso <SPAN style="color:#00007F">As</SPAN> Scripting.FileSystemObject   <SPAN style="color:#007F00">'Requires reference to Microsoft Scripting Runtime</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> bytMsgBox <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>                   <SPAN style="color:#007F00">'Holds the users response to message boxes.</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> boolGotFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>          <SPAN style="color:#007F00">'Informs if a valid file name was received.</SPAN>
<SPAN style="color:#00007F">Set</SPAN> fso = <SPAN style="color:#00007F">New</SPAN> Scripting.FileSystemObject
<SPAN style="color:#007F00">'Make sure a valid file name was recieved.</SPAN>
<SPAN style="color:#00007F">If</SPAN> strFileName = strFalse <SPAN style="color:#00007F">Or</SPAN> strNewFileName = str<SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#00007F">If</SPAN> strFileName = strNewFileName <SPAN style="color:#00007F">Then</SPAN>
    MsgBox "Cannot copy a file to the same location as itself.", vbExclamation, "Invalid Location"
    <SPAN style="color:#00007F">Else</SPAN>
    <SPAN style="color:#00007F">If</SPAN> fso.FileExists(strNewFileName) <SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> boolSilent <SPAN style="color:#00007F">Then</SPAN> bytMsgBox = MsgBox("A file already exists in that location, do you wish to overwrite it?", vbQuestion + vbYesNoCancel, "Confirm Overwrite")
        <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> bytMsgBox
            <SPAN style="color:#00007F">Case</SPAN> vbCancel: <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
            <SPAN style="color:#00007F">Case</SPAN> vbNo: boolGotFileName = <SPAN style="color:#00007F">False</SPAN>
            <SPAN style="color:#00007F">Case</SPAN> vbYes
                <SPAN style="color:#00007F">If</SPAN> WorkBookOpened(strNewFileName) <SPAN style="color:#00007F">Then</SPAN>
                    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> boolSilent <SPAN style="color:#00007F">Then</SPAN> MsgBox "Cannot overwrite a file that is open. Please close the file and try again.", vbExclamation, "Overwrite Failed"
                    <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
                    <SPAN style="color:#00007F">Else</SPAN>
                    boolGotFileName = <SPAN style="color:#00007F">True</SPAN>
                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> boolSilent <SPAN style="color:#00007F">Then</SPAN> MsgBox "Unexpected response. Operation aborted.", vbExclamation, "Invalid Response"
                <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        Else: boolGotFileName = <SPAN style="color:#00007F">True</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> boolGotFileName <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
fso.CopyFile Source:=strFileName, Destination:=strNewFileName, OverWriteFiles:=<SPAN style="color:#00007F">True</SPAN>
BackupWorkBook = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> boolSilent <SPAN style="color:#00007F">Then</SPAN> MsgBox "Backup complete.", vbInformation, "File Copied"
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
Err_Hnd:
BackupWorkBook = <SPAN style="color:#00007F">False</SPAN>
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
<SPAN style="color:#00007F">Sub</SPAN> StripVBA(wbTarget <SPAN style="color:#00007F">As</SPAN> Excel.Workbook, <SPAN style="color:#00007F">Optional</SPAN> <SPAN style="color:#00007F">ByVal</SPAN> boolRmvForms <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN> = False)
<SPAN style="color:#007F00">'This code was originally written by Aaron Bush 2006</SPAN>
<SPAN style="color:#007F00">'It is not to be altered or distributed,</SPAN>
<SPAN style="color:#007F00">'except as part of an application.</SPAN>
<SPAN style="color:#007F00">'You are free to use it in any application,</SPAN>
<SPAN style="color:#007F00">'provided the copywrite notice is left unchanged.</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Code Courtesy of</SPAN>
<SPAN style="color:#007F00">'Aaron Bush</SPAN>
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">'Copywrite verbage courtesy of Dev Ashish</SPAN>
<SPAN style="color:#007F00">'Needs reference to Microsoft Visual Basic For Applications Extensibility library</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> proj <SPAN style="color:#00007F">As</SPAN> VBIDE.VBProject
<SPAN style="color:#00007F">Dim</SPAN> cmp <SPAN style="color:#00007F">As</SPAN> VBIDE.VBComponent
<SPAN style="color:#00007F">Dim</SPAN> lngCOL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>              <SPAN style="color:#007F00">'Count of project lines</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> bytCompType <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Byte</SPAN>         <SPAN style="color:#007F00">'Holds the current component type</SPAN>
<SPAN style="color:#00007F">Set</SPAN> proj = wbTarget.VBProject
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Err_Hnd
<SPAN style="color:#007F00">'Remove Standard Modules and clean Document Modules</SPAN>
<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cmp <SPAN style="color:#00007F">In</SPAN> proj.VBComponents
    bytCompType = cmp.Type
    <SPAN style="color:#00007F">If</SPAN> bytCompType = vbext_ct_StdModule <SPAN style="color:#00007F">Then</SPAN> proj.VBComponents.remove cmp
    <SPAN style="color:#00007F">If</SPAN> bytCompType = vbext_ct_Document <SPAN style="color:#00007F">Then</SPAN>
        lngCOL = cmp.CodeModule.CountOfLines
        <SPAN style="color:#00007F">If</SPAN> lngCOL <> 0 <SPAN style="color:#00007F">Then</SPAN>
            cmp.CodeModule.DeleteLines 1, lngCOL
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">If</SPAN> boolRmvForms And bytCompType = vbext_ct_MS<SPAN style="color:#00007F">For</SPAN>m <SPAN style="color:#00007F">Then</SPAN> proj.VBComponents.remove cmp
<SPAN style="color:#00007F">Next</SPAN> cmp
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
Err_Hnd:
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">Function</SPAN> WorkBookOpened(<SPAN style="color:#00007F">ByVal</SPAN> strFileName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> wb <SPAN style="color:#00007F">As</SPAN> Excel.Workbook
<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> wb <SPAN style="color:#00007F">In</SPAN> Excel.Workbooks
<SPAN style="color:#00007F">If</SPAN> wb.FullName = strFileName <SPAN style="color:#00007F">Then</SPAN>
    WorkBookOpened = <SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">Exit</SPAN> For
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> wb
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
</FONT>
 

tombrown

Board Regular
Joined
Jun 2, 2006
Messages
50
Apologies for not replying, I am currently travelling.

This is brilliant - many thanks. I will try it out as soon as I get back to the office
 

Forum statistics

Threads
1,141,734
Messages
5,708,168
Members
421,549
Latest member
Dtcfire

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top