Consulting

Results 1 to 2 of 2

Thread: Solved: Copy a Sheet,delete a range Then save the org Template

  1. #1
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location

    Solved: Copy a Sheet,delete a range Then save the org Template

    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
    Attached Files Attached Files

  2. #2
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •