I am struggling to convert my XLSM to XLSX File..it was before transformation to PDF, and I tried to change a bit but didnt succeed.
I wanna to have the same name as the workbook has, but just in XLSX format.
Sub xlsmtoxlsx()
Dim PathFile As String
Dim PathArray() As String
Dim PathPDF As String
'Get file path
PathFile = Application.ThisWorkbook.FullName
'Split file path in path and file ending
PathArray() = Split(PathFile, ".")
'Creat file path with ".pdf" ending
PathPDF = PathArray(0) & ".xlsx"
'PDF File is saved in directory of workbook
ActiveSheet.ExportAsFixedFormat Type:=xlTypeXlsx, Filename:= _
PathPDF, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
'Closes Workbook after generating PDF
ActiveWorkbook.Saved = True
Application.Quit
Backup as XLSX
Option Explicit
Sub BackupAsXLSX()
' Create a reference to the source workbook.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
' Determine the destination file path ('FullName').
Dim sFilePath As String: sFilePath = swb.FullName
Dim DotPosition As Long: DotPosition = InStrRev(sFilePath, ".")
Dim dFilePath As String: dFilePath = Left(sFilePath, DotPosition) & "xlsx"
Application.ScreenUpdating = False
' Copy all sheets to a new (destination) workbook.
swb.Sheets.Copy
Dim dwb As Workbook: Set dwb = ActiveWorkbook
' Save and close the destination workbook.
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
Application.ScreenUpdating = True
' Inform.
MsgBox "XLSX backup created.", vbInformation
' Note that the source workbook hasn't been modified in any way.
End Sub
Related
I am trying to export tabs in my excel workbook which are in green color into csv files. Any pointers will be much appreciated.
Export to CSV
Basic
Sub ExportToCSV()
Const DST_PATH As String = "C:\Test"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Application.ScreenUpdating = False
Dim sws As Worksheet
Dim dwb As Workbook
Dim dFilePath As String
For Each sws In wb.Worksheets
If sws.Tab.Color = vbGreen Then
sws.Copy ' creates a new single-worksheet workbook
Set dwb = Workbooks(Workbooks.Count)
dFilePath = DST_PATH & Application.PathSeparator & sws.Name & ".csv"
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlCSV ' xlCSVUTF8
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
End If
Next sws
Application.ScreenUpdating = True
MsgBox "Worksheets exported.", vbInformation
End Sub
I tried this coding without succes - any good ideas??
Private Sub CommandButton5_Click()
Sub SavePlan()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("Main")
Dim FolderPath As String: FolderPath = wb.Path
Dim dFileName As String: dFileName = sws.Range("C6").Value
Dim dFilePath As String
dFilePath = FolderPath & Application.PathSeparator & dFileName
sws.Copy ' copy to a new (destination) workbook
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dFilePath
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
MsgBox "Worksheet backed up.", vbInformation
End Sub
Please, try using the next adapted code. It assumes that dFilePath does not contain any extension. If it does, you must tell us what it is and I can adapt the code:
Sub SavePlan()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("Main")
Dim FolderPath As String: FolderPath = wb.Path
Dim dFileName As String: dFileName = sws.Range("C6").value
Dim dFilePath As String
dFilePath = FolderPath & Application.PathSeparator & dFileName 'no extension...
sws.Copy ' it creates a new workbook containing only the copied sheet
Dim dwb As Workbook: Set dwb = ActiveWorkbook
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.saveas FileName:=dFilePath & ".xlsx", FileFormat:=xlWorkbookDefault
dwb.ExportAsFixedFormat Type:=xlTypePDF, FileName:=dFilePath & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.DisplayAlerts = True
dwb.Close False
MsgBox "Worksheet backed up.", vbInformation
End Sub
I am currently using following code to save an Excel workbook. Instead of saving complete work book, I just wish to save a sheet in this workbook named Reconciliation. All values in the sheet should be saved as values while keeping the formatting the same.
Sub Button3_Click()
' Yes
' Code to save consumer wise mirs on the desktop
Dim Path As String
Dim filename As String
On Error GoTo Err_Clear
Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Err_Clear:
If Err <> 0 Then
MkDir CreateObject("wscript.shell").specialfolders("desktop") & "\rohailnisar"
Path = Environ("USERPROFILE") & "\Desktop\rohailnisar\"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
End Sub
Export a Worksheet
This saves a copy of a worksheet as the only sheet in a new workbook in the same folder. Before saving, it converts formulas to values. It is saved in the .xlsx format 'removing' any code.
If the code is in the open (initial) workbook, then replace ActiveWorkbook with ThisWorkbook.
Option Explicit
Sub SaveWorksheet()
On Error GoTo ClearError
Dim swb As Workbook: Set swb = ActiveWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets("Reconciliation")
Dim FolderPath As String: FolderPath = swb.Path & Application.PathSeparator
Dim BaseName As String: BaseName = sws.Range("E1").Value
Dim FilePath As String: FilePath = FolderPath & BaseName & ".xlsx"
sws.Copy
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
dwb.Worksheets(1).UsedRange.Value = dwb.Worksheets(1).UsedRange.Value
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
'dwb.Close
ProcExit:
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
Instead of saving complete work book, I just wish to save a sheet in this workbook named Reconciliation. All values in the sheet should be saved as values while keeping the formatting the same.
Code
Dim wbThis As Workbook
Dim wsThis As Worksheet
Dim wbThat As Workbook
Dim wsThat As Worksheet
'~~> Change this to the workbook which has the Reconciliation sheet
Set wbThis = ThisWorkbook
Set wsThis = wbThis.Sheets("Reconciliation")
'~~> This will create a new workbook with only Reconciliation
wsThis.Copy
'~~> Get that object. It will be last in the queue
Set wbThat = Workbooks(Workbooks.Count)
Set wsThat = wbThat.Sheets("Reconciliation")
'~~> Convert to values
wsThat.UsedRange.Value = wsThat.UsedRange.Value
'~~> Save that workbook
wbThat.SaveAs Filename:=Path & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
I have a function that basically makes a copy of the current file, and save it to users' "Downloads" folder.
However, while the SaveAs works, the output does not contain any modules. Instead, they are all linked to the exporting file.
Sub PushToProduction()
Application.ScreenUpdating = False
' save a copy of current file to the Downloads folder
outputPath = Environ$("USERPROFILE") & "\Downloads\"
d = Format(Date, "yyyymmdd")
fileName = outputPath & "REDACTED " & d & " v1.00.xlsm"
' prepare to save a copy of the file without the last tab
sheetCount = Application.Sheets.Count - 1
Dim tabs() As String
ReDim tabs(1 To sheetCount)
For i = 1 To sheetCount
tabs(i) = Worksheets(i).Name
Next
Worksheets(tabs).Copy
ActiveWorkbook.SaveAs fileName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox ("Success!")
End Sub
The output does not even have the "Modules" folder.
Is there anyway to solve this?
Create a Workbook Copy and Modify It
Option Explicit
Sub PushToProduction()
Dim dFolderPath As String
dFolderPath = Environ$("USERPROFILE") & "\Downloads\"
Dim d As String: d = Format(Date, "yyyymmdd")
Dim dFilePath As String
dFilePath = dFolderPath & "REDACTED " & d & " v1.00.xlsm"
Application.ScreenUpdating = False
' Create a reference to the Source Workbook ('swb').
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
' Save a copy of the Source Workbook.
If StrComp(dFilePath, swb.FullName, vbTextCompare) = 0 Then
MsgBox "You are trying save a copy of the file to the same location.", _
vbCritical, "Push to Production"
Exit Sub
End If
swb.SaveCopyAs dFilePath
' Open the copy, the Destination Workbook ('dwb'), remove its last sheet
' and close saving the changes.
Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
Application.DisplayAlerts = False
dwb.Sheets(dwb.Sheets.Count).Delete
Application.DisplayAlerts = True
dwb.Close SaveChanges:=True
Application.ScreenUpdating = True
' Inform.
MsgBox "Success!", vbInformation, "Push to Production"
' Explore Destination Folder.
'swb.FollowHyperlink dFolderPath
End Sub
I have a workbook with 3 sheets in them, I am using the below macro to export the sheets as .csv files. However sheet1 gets exported with the data in it and sheet2 gets exported without any data in it and is a blank file. The goal is to successfully export Sheet1 and Sheet2 as .csv files with data in them without overwriting the original workbook. Any help would be much appreciated.
Sub Export_Files_Click()
Dim ws As Worksheet
Dim path As String
path = ActiveWorkbook.path & "\" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)
For Each ws In Worksheets
ws.Activate
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
Next
End Sub
Export Worksheets (to Separate Workbooks)
Consider the active workbook named Test.xlsm containing only worksheets Sheet1 and Sheet2 (tab names).
Then the following, run from this or another workbook, will save the files Test_Sheet1.csv (containing only the worksheet Sheet1) and Test_Sheet2.csv (containing only the worksheet Sheet2) to the active workbook's path (folder).
Standard Module e.g. Module1
Option Explicit
Sub ExportWorksheets()
Dim swb As Workbook: Set swb = ActiveWorkbook
Dim swbPathAndLeftName As String: swbPathAndLeftName _
= swb.path & "\" & Left(swb.Name, InStrRev(swb.Name, ".") - 1) & "_"
Application.ScreenUpdating = False
Dim sws As Worksheet
Dim dwb As Workbook
Dim dFilePath As String
For Each sws In swb.Worksheets
dFilePath = swbPathAndLeftName & sws.Name & ".csv"
sws.Copy ' copies worksheet to a new (one worksheet) workbook...
Set dwb = ActiveWorkbook ' ... which becomes active
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlCSV, _
CreateBackup:=False ', Local:=True ' if semicolon instead of comma
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
Next sws
Application.ScreenUpdating = True
MsgBox "Worksheets exported.", vbInformation, "Export Worksheets"
End Sub
The CommandButton (wherever)
Sub Export_Files_Click()
ExportWorksheets
End Sub