Hi All
I have a excel template from which we download info from our DMS system.
I have managed to copy the template from the original and put it in C folder ok.
The next step i wanted to create, was to close the copy sheet, then go back to the original template, delete range A2:P500 save the sheet then quit excel.
Password for the sheet = "AMN"
Have attached a copy with the code if anybody could help with the missing bits.
Thanks
Here is the code to save opening the file:
'//In the worksheet
[VBA]
Option Explicit
Sub CommandButton1_Click()
Call Module1.CommandButton1_Click
Workbooks.Open Filename:="C:\AMN\Nissan Template.xls"
Range("A2:P500").Select
Selection.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Quit
End Sub
'//In module 1
[VBA]
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim _
wksCopy As Worksheet, _
wkscmdBttn As OLEObject, _
wbNew As Workbook, _
wksNew As Worksheet, _
strFullName As String, _
MyFilePath As String
Const PWD As String = "AMN"
Application.EnableEvents = False
'// Copy the worksheet to past the last sheet and set a reference to the copy.
With ThisWorkbook
.Worksheets("sheet1").Copy After:=.Worksheets(.Worksheets.Count)
Set wksCopy = .Worksheets(.Worksheets.Count)
End With
With wksCopy
'// Change path to suit...C:\
MyFilePath = "C:\AMN\"
strFullName = "C:\AMN\Nissan Template Data" & " " & Format(Now, "YYYY-MM-DD HH_MM_SS") & ".xls"
'// Unprotect the new copy, kill any commandbuttons and re-protect.
.Unprotect Password:=PWD
For Each wkscmdBttn In .OLEObjects
If TypeName(wkscmdBttn.Object) = "CommandButton" Then
wkscmdBttn.Delete
End If
Next
'// Set a reference to a new, one-sheet wb; move the copied sheet to it, kill
'// the blank sheet.
Set wbNew = Workbooks.Add(xlWBATWorksheet)
.Move After:=wbNew.Worksheets(1)
Application.DisplayAlerts = False
wbNew.Worksheets(1).Delete
Application.DisplayAlerts = True
End With
With ActiveWorkbook.Sheets(1).UsedRange
.Value = .Value
End With
With ActiveWorkbook.Sheets(1).Cells
.Validation.Delete
.FormatConditions.Delete
End With
'// Set a reference to the copied sheet in the new wb, rename the sheet (to rid the
'// " (2)" ), and save the new wb.
With wbNew
Set wksNew = .Worksheets(1)
wksNew.Name = "Nissan Data"
'// Protect the copy sheet & all ranges to stop anybody amending the data
Range("A2:P500").Select
Selection.Locked = True
Selection.FormulaHidden = True
ActiveSheet.Protect Password:=PWD
ActiveWorkbook.Protect Password:=PWD
'// Check if folder exsists if not create one
On Error Resume Next '<< a folder exists resume next line
Application.DisplayAlerts = False
MkDir MyFilePath '<< create a folder
Application.DisplayAlerts = True
.SaveAs Filename:=strFullName
End With
Application.ScreenUpdating = True
ActiveSheet.Close False
ThisWorkbook.Close False
End Sub