I have a MASTER excel spreadsheet used as a template so I could refresh a CONNECTION ( .csv file) with a new data table that links to my pivot table.
Right now I have a macro to SAVE AS COPY to a specific path, since I want to keep the original intact.
Sub SaveCopyPath()
With ActiveWorkbook
.SaveCopyAs "C:\Users\Me\" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm"
End With
End Sub
I'm looking for a VBA Code that would apply only to my SAVED AS COPY with these:
BREAK the connection on the data table
Delete TAB1 and TAB2 on the saved copy only and keep the Pivot Table & "Data" intact on the saved copy.
This uses the ListObject.Unlink method to delete the data connection. The rest should be straightforward:
Sub SaveCopyPath()
Dim SavedCopy As Excel.Workbook
ActiveWorkbook.SaveCopyAs "C:\Users\Me\" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm"
Workbooks.Open "C:\Users\Me\" & Format(Date, "mmddyyyy") & "-" & [A1] & ".xlsm"
Set SavedCopy = ActiveWorkbook
With SavedCopy
.Worksheets("Data").ListObjects(1).Unlink
Application.DisplayAlerts = False
.Worksheets(1).Delete
.Worksheets(1).Delete
Application.DisplayAlerts = True
.Close True
End With
End Sub
Related
I have an Excel that gets updated with sales numbers daily. At the end of the week, when the Excel is complete, I export a PDF copy of the WEEKLY worksheet. Once I have a PDF copy, the sales numbers are transferred to another sheet within the workbook, emptying the WEEKLY worksheet.
In addition to this PDF copy of the WEEKLY worksheet, I'd like to export the entire workbook in a separate Excel file to the same location (.xls format is fine). I'd like to do this before emptying the WEEKLY worksheet. I've tried using a save as macro, but I want to remain in my original Excel - not the newly saved file.
For reference, here's the VBA code for my PDF export:
Sub SaveWeekly()
'
' SaveWeekly Macro
'
'
Sheets("WEEKLY").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"Z:\Excel New\Previous Excels\" & Range("A1") & " " & Range("H1") & ", " & Format(Date, "yyyy") & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Any help is appreciated.
Try this code
Sub Test()
Dim strDate As String
Dim strTime As String
strDate = Format(Date, "DD-MM-YYYY")
strTime = Format(Time, "hh.mm.ss")
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveCopyAs fileName:=ThisWorkbook.Path & "\" & strDate & "_" & strTime & "_" & .Name
End With
Application.DisplayAlerts = True
End Sub
I am trying to save a copy of ThisWorkbook in xlsx while using SaveCopyAs. The problem is that SaveCopyAs saves the file as a macro enabled file, xlsb in my case which is not desired and while SaveAs does what I need, it also closes ThisWorkbook .
Is there an easier way to save in a format that does not support macros and without doing workarounds ?
Currently the best solution I found is the code snip below, but it's kinda finicky and it does not save the ContentTypeProperties that I need further on in the project, so does need to be added again.
Any ideas are appreciated, thanks!
Dim sPath as String
sPath = ThisWorkbook.FullName
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sFileName & ".xlsx", 51
Application.Workbooks.Open (sPath)
Application.DisplayAlerts = True
Exit Sub
Define your path sPath = ThisWorkbook.Path & "\" & sFileName without extension
Use ThisWorkbook.SaveCopyAs sPath & ".xlsm" to save a copy.
Open that copy with Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
Save again without Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
Close workbook Wb.Close SaveChanges:=False
So something like the following should work, and would keep your current code running without any re-opening side effects of the current workbook.
Dim sPath As String
sPath = ThisWorkbook.Path & "\" & sFileName 'no extension!
ThisWorkbook.SaveCopyAs sPath & ".xlsm"
Dim Wb As Workbook
Set Wb = Application.Workbooks.Open(sPath & ".xlsm")
Wb.SaveAs sPath & ".xlsx", xlOpenXMLWorkbook
Wb.Close SaveChanges:=False
And probably you want to delete the xlsm file copy
Kill sPath & ".xlsm"
You might want to make use of Application.DisplayAlerts = False and Application.ScreenUpdating = False.
I have this userform
It is fully fuctioning but I want to add a feature that is sending the file as .xlsx or .txt so I can remove the macro from the file.
I searched the internet for days and come up to a procedure that I need to make a 3 process to save it to another format. The process I come up is listed below:
1. .SaveCopyAs
Copy(Filename).(Same format)
.Open
Existing File
.SaveAs
(FileName).(Any format)
And delete the SaveCopyAs file to avoid redundancy Or catch the temporary file to SaveAs another file format? Every input should be save after clicking ok button and to overwrite the existing file.
Can someone tell me if I'm making the right approach to my problem? Thanks.
I have had a similar issue, my solution involved copying the Sheets into a new workbook then renaming them accordingly and saving that workbook with a specific name:
ans = MsgBox("Would you like to export the Report?", vbYesNo)
Select Case ans
Case vbYes
FPath = "C:\...\...\... Daily Report"
FName = "Report" & ".xlsx"
Set NewBook = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=NewBook.Sheets(1)
ThisWorkbook.Sheets("Sheet3").Copy Before:=NewBook.Sheets(1)
Application.DisplayAlerts = False
'NewBook.Sheets("Sheet1").Delete to delete the first empty sheet on the new workbook
If Dir(FPath & "\" & FName) <> "" Then
MsgBox "File " & FPath & "\" & FName & " already exists"
Else
NewBook.SaveAs Filename:=FPath & "\" & FName
End If
NewBook.Close False
CurrentReport = FPath & "\" & FName
Case vbNo
Exit Sub
End Select
Or to append the data to a text file, each time the user clicks "OK":
Sub VBA_to_append_existing_text_file()
Dim strFile_Path As String
strFile_Path = "C:\temp\test.txt" ‘Change as per your test folder and exiting file path to append it.
Open strFile_Path For Append As #1
Write #1, "This is my sample text" ' add entered data here
Close #1
End Sub
I am trying to save a particular worksheet from my working workbook to another workbook, and trying to save it in the path of my current workbook. The saving option is in such a way that it should get saved with the dd.mm.yyyy.
I tried the following code and I am getting application defined error in the line
> newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") &
> myWorksheets(i), FileFormat:=xlsx
Could you please help me figure out where I am wrong?
Sub save()
Dim myWorksheets() As String 'Array to hold worksheet names to copy
Dim newWB As Workbook
Dim CurrWB As Workbook
Dim i As Integer
Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\TT"
Set CurrWB = ThisWorkbook
myWorksheets = Split("Report", ",")
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
Set newWB = Workbooks.Add 'Create new workbook
CurrWB.Sheets(Trim(myWorksheets(i))).Copy
newWB.SaveAs filename:=Path2 & Format(Now(), "yyyymmdd") & myWorksheets(i), FileFormat:=xlsx
newWB.Close saveChanges:=False
Next i
CurrWB.Save 'save original workbook.
End Sub
#Jenny - This code will accomplish what you ask in your question, it will save the ActiveSheet as a new file; and can be used as a function the can be called within your code. You can change the "Rpt" to identify the title of the new workbook. When I'm writing vba code, I always try to follow what my mother use to say to me, "Keep it simple".
Application.DisplayAlerts = False
Dim wbPath As String
wbPath = ThisWorkbook.Path
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=wbPath & "\" & "Rpt" & " " & Format(Date, "yyyymmdd") & ".xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
Basically, I'd like to save some worksheets into separate new workbooks in the same system location as original notebook I am deriving from.
I recognize that the default path is to save something new is to the location of the current notebook, but perhaps since I am opening a new workbook the default reverts to the user's Document's folder, which is where they are saving right now.
I "learned" VBA over the last couple of days, so advice on other things you notice is cool too, but the saveas is what's bothering me.
Dim ws As Worksheet
Dim wb As Workbook
Dim dept_array As Variant
Dim dept As Variant
' Add or remove a department name spelled exactly as it is in the filter
dept_array = Array("HR", "IT", "Marketing", "Product Marketing", "Sales", "Channels", "Presales", "Direct", "Sales Ops", "R&D", "Support", "G&A")
Application.ScreenUpdating = False
For Each ws In Workbooks("Weekly Department Transaction Report.xlsm").Worksheets
For Each dept In dept_array
If Application.Proper(ws.Name) = Application.Proper(dept) _
Then
Set wb = Workbooks.Add
ThisWorkbook.Sheets(dept).Copy Before:=wb.Sheets(1)
wb.Saveas dept & "_" & Format(Now, "yyyymmdd") & ".xlsx"
Workbooks("Weekly Department Transaction Report.xlsm").Sheets("Codes").Copy After:=Workbooks(dept & "_" & Format(Now, "yyyymmdd") & ".xlsx").Sheets(dept)
Workbooks("Weekly Department Transaction Report.xlsm").Sheets("How").Copy Before:=Workbooks(dept & "_" & Format(Now, "yyyymmdd") & ".xlsx").Sheets(dept)
Workbooks(dept & "_" & Format(Now, "yyyymmdd") & ".xlsx").Save
End If
Next dept
Next ws
Application.ScreenUpdating = True
End Sub
Please let me know if I am not following the correct stackoverflow format.
Longtime user first time asker :)
Edit this line in your code:
wb.SaveAs FileName:= ThisWorkbook.Path & "\" & dept & "_" & Format(Now, "yyyymmdd") & ".xlsx"