Save active workbook by clicking command button

[bhandari]

i have a data which is in xlsm.
by clicking command button i want to save it as a new .xlsx file
macros should not save on .xlsx file

 

[Jeffrey Mahoney]

Re: how to save active workbook by clicking command button

I pulled this out of a project I'm working on. It is designed to create an XLS file with some formatting that is the same format as the original. It asks the user where to save the file and what to name it. It creates a copy of the data in a new workbook and saves it as the named provided. Hope that gets you started.

Sub ExportOtherCharges()
  Dim cel As Range
  Dim R As Range
  Dim LC As Range
  Dim OutR As Range
  Dim TWB As Workbook
  Dim ExpWB As Workbook
  Dim OCSht As Worksheet
  Dim ExpSht As Worksheet
  Dim FSA As Variant
  Dim PathFile As String
  Dim FileName As String
  Dim Path As String
  Dim v As Variant
  Dim A As String
  
  Set TWB = ThisWorkbook
  Set OCSht = TWB.Sheets("Other Charges")
  Set cel = OCSht.Range("A2")
  Set R = OCSht.Range(cel, cel.End(xlDown))
  
  For Each cel In R
    If cel.Value <> "" Then
      Set LC = cel
    Else
      Exit For
    End If
  Next cel
  
  Set cel = OCSht.Range("A1")
  Set R = OCSht.Range(cel, Intersect(LC.EntireRow, cel.End(xlToRight).EntireColumn))
  
  FSA = Application.GetSaveAsFilename("Other Charges.xls", "Excel Files (*.xls), *.xls", , "Select a File Name for 'Other Charges'")
  If FSA = False Then Exit Sub
  PathFile = FSA
  
  
  A = Dir(PathFile, vbNormal)
  If A <> "" Then
    FileName = GetFileName(PathFile)
    v = MsgBox(FileName & " already exists. Do you want to overwrite it?", vbYesNoCancel)
    If v <> vbYes Then Exit Sub
  End If
  
  
  Workbooks.Add
  
  Set ExpWB = ActiveWorkbook
  Set ExpSht = ExpWB.ActiveSheet
  Set cel = ExpSht.Range("A1")
  Set OutR = ExpSht.Range(cel, cel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
  R.Copy
  OutR.PasteSpecial (xlPasteValuesAndNumberFormats)
  ExpSht.Name = "Other Charges"
  
  
  OutR.EntireColumn.AutoFit
  ExpSht.Range("A1").Select
  
  
  On Error Resume Next
  Application.DisplayAlerts = False
  ExpWB.SaveAs PathFile, xlExcel8
  ExpWB.Close savechanges:=False
  Beep
  Beep
  Application.DisplayAlerts = True
  On Error GoTo 0
  
  Set TWB = Nothing
  Set OCSht = Nothing
  
End Sub

 

[bhandari]

Re: how to save active workbook by clicking command button

Get file name:sub or function not defined

 

[Jeffrey Mahoney]

Re: how to save active workbook by clicking command button

My bad

Function GetFileName(PathFile As String) As String


  Dim X As Long
  Dim A As String
  Dim BS As Integer
  
  A = PathFile
  For X = Len(A) To 1 Step -1
    If Mid(A, X, 1) = "\" Then
      BS = X + 1
      Exit For
    End If
  Next X
  If BS > 0 Then
    GetFileName = Mid(A, BS)
  Else
    GetFileName = A
  End If
End Function

 

[bhandari]

Re: how to save active workbook by clicking command button

 Set TWB = ThisWorkbook
  Set OCSht = TWB.Sheets("Other Charges")
  Set cel = OCSht.Range("A2")
  Set R = OCSht.Range(cel, cel.End(xlDown))

what is this code for iam geetting error,what to change?

 

[Jeffrey Mahoney]

Re: how to save active workbook by clicking command button

You are going to have to edit this macro. The names of the sheets and the ranges need to be change to your needs.