Copy file help

Please can you help:-

Sheets(Array("Low Volume", "DataSheet")).Copy

With the attached code it saves a copy of sheets 4 & 6. The trouble is that within the copied file, the launch userform no longer works.

When I open the file the Forms module is not copied.

Please can you help alter the code so that the entire workbook is copied.

Private Sub CommandButton2_Click()
Dim strPath As String, strFileName As String
Dim Extn As String, strFname As String
Dim INUm As Long, CheckMe As Long

strPath = "C:\Documents and Settings\Administrator\My Documents\Gary\project\New Folder\"
strFileName = "Summary_" & Format(Sheets("Low Volume").Range("C5").Value, "YYYY-MM-DD")
Extn = ".xls"

strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
Do While Len(strFname) <> 0
INUm = INUm + 1
strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
Loop

Sheets(Array("Low Volume", "DataSheet")).Copy
ActiveWorkbook.SaveAs Filename:=strPath & strFileName & "_" & INUm & Extn
ActiveWorkbook.Close
CheckMe = MsgBox("Clear Contents?", vbYesNo)
If CheckMe = vbYes Then

Sheets("Low Volume").Unprotect Sheets("DataSheet").Range("B2").Value
ThisWorkbook.ActiveSheet.Range("B14:K414,W14:W414,N14:N414,Q14:Q414").ClearContents
Sheets("Low Volume").Protect Sheets("DataSheet").Range("B2").Value
 End If
End Sub

Open in new window

gary-test3.xls
Gazza83Asked:
Who is Participating?
 
DaveConnect With a Mentor Commented:
hth

Dave
Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs strThisPath
    Application.DisplayAlerts = True

Open in new window

0
 
DaveCommented:
Gary,

As you are effectively copying the entireworkbook I suggest you do a SaveAs rather than a Copy, then resave the file with its original path

This is a lot cleaner than writing code to programmatically copy the UserForm and Module code

The only caution is whether you don't want to save the model at this time

Cheers

Dave
Private Sub CommandButton2_Click()
    Dim strPath As String, strFileName As String
    Dim Extn As String, strFname As String
    Dim INUm As Long, CheckMe As Long
    Dim strThisPath As String
    strThisPath = ThisWorkbook.FullName


    strPath = "C:\Documents and Settings\Administrator\My Documents\Gary\project\New Folder\"
    strFileName = "Summary_" & Format(Sheets("Low Volume").Range("C5").Value, "YYYY-MM-DD")
    Extn = ".xls"

    strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
    Do While Len(strFname) <> 0
        INUm = INUm + 1
        strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
    Loop

    ActiveWorkbook.SaveAs Filename:=strPath & strFileName & "_" & INUm & Extn
    CheckMe = MsgBox("Clear Contents?", vbYesNo)
    If CheckMe = vbYes Then
        Sheets("Low Volume").Unprotect Sheets("DataSheet").Range("B2").Value
        ThisWorkbook.ActiveSheet.Range("B14:K414,W14:W414,N14:N414,Q14:Q414").ClearContents
        Sheets("Low Volume").Protect Sheets("DataSheet").Range("B2").Value
    End If
    ActiveWorkbook.SaveAs strThisPath
End Sub

Open in new window

0
 
Gazza83Author Commented:
I want the 'orginal file' to retain its own file name. So the 'Archive' file would be separate because it will have a different file name.

If there is a way to SaveAs without unpdating the name of the currently opened workbook then that would be just what  I need.
0
 
DaveCommented:
> I want the 'orginal file' to retain its own file name. So the 'Archive' file would be separate because it will have a different file name

Thats what my code does
ie saves the archive file
then resaves the 'orginal file' with the original name ( ActiveWorkbook.SaveAs strThisPath)

Cheers

Dave


0
 
Gazza83Author Commented:
Ah I see now, it might be just my pc, but I get a command prompt as whether to replace the existing file.

is there a way to disable this? Or to add "_1" to the file name
save-as.JPG
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.