Overwrite existing files and save as PDF XLSM and new sheet

Rasmusjc

New Member
Joined
Jul 29, 2018
Messages
18
Hi

I have this save button, that saves:
  • 3 sheets into pdf
  • 4 sheets into a new workbook (xlsm)
  • 1 sheet into a new copy inside the workbook

My problem is if i want to save the sheets again it dosn't overwrite the old one.

So my question is how to change the code so it overwrite existing files if necessary?

Here is my code

Code:
Sub Gemsom() 
 
Dim fName As String
With Worksheets("Prisliste")
    fName = ThisWorkbook.Worksheets("Prisliste").Range("D1").Value & ThisWorkbook.Worksheets("Prisliste").Range("E10").Value & ThisWorkbook.Worksheets("Prisliste").Range("D4").Value
End With
Worksheets("Tilbud").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\rasmu\Desktop\2019\Tilbud\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
Worksheets("Lejekontrakt").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\rasmu\Desktop\2019\Lejekontrakt\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
Worksheets("Faktura").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\rasmu\Desktop\2019\Faktura\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
            
    Sheets(Array("Prisliste", "Tilbud", "Lejekontrakt", "Faktura")).Copy
    'there is now a new active workbook
    With ActiveWorkbook
        'save it
        .SaveAs Filename:= _
        "C:\Users\rasmu\Desktop\2019\" & ThisWorkbook.Worksheets("Prisliste").Range("D1").Value & ThisWorkbook.Worksheets("Prisliste").Range("E10").Value & ThisWorkbook.Worksheets("Prisliste").Range("D4").Value, FileFormat:=52
        'optionally close it
        .Close savechanges:=True
    End With




End Sub
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,674
Office Version
365
Platform
Windows
try adding these 2 lines:

Code:
[COLOR=#b22222]Application.DisplayAlerts = False[/COLOR]
        'save it
        .SaveAs Filename:= _
        "C:\Users\rasmu\Desktop\2019\" & ThisWorkbook.Worksheets("Prisliste").Range("D1").Value & ThisWorkbook.Worksheets("Prisliste").Range("E10").Value & ThisWorkbook.Worksheets("Prisliste").Range("D4").Value, FileFormat:=52
        'optionally close it
        .Close savechanges:=True
[COLOR=#b22222]Application.DisplayAlerts = True[/COLOR]
 

Rasmusjc

New Member
Joined
Jul 29, 2018
Messages
18
Thanks Yongle

If works for the PDF files and the new workbook.

I dont know why i forgot to paste the code for "save"
  • 1 sheet into a new copy inside the workbook

Is it possible to do the same with this code so it just overwrite if the sheet allready excist

Code:
             Dim ws As Worksheet    Set wh = Worksheets(ActiveSheet.Name)
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    If wh.Range("D1").Value <> "" Then
    ActiveSheet.Name = wh.Range("D1").Value
    End If
    wh.Activate
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,658
Hi,
Try this:
Rich (BB code):
Sub Test()
  Dim ws As Worksheet
  Set ws = ActiveSheet
  Application.ScreenUpdating = False
  ws.Copy After:=Worksheets(Sheets.Count)
  If ws.Range("D1").Value <> "" Then
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(ws.Range("D1").Value).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    ActiveSheet.Name = ws.Range("D1").Value
  End If
  ws.Activate
  Application.ScreenUpdating = True
End Sub
Regards
 

Rasmusjc

New Member
Joined
Jul 29, 2018
Messages
18
Hi,
Try this:
Rich (BB code):
Sub Test()
  Dim ws As Worksheet
  Set ws = ActiveSheet
  Application.ScreenUpdating = False
  ws.Copy After:=Worksheets(Sheets.Count)
  If ws.Range("D1").Value <> "" Then
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(ws.Range("D1").Value).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    ActiveSheet.Name = ws.Range("D1").Value
  End If
  ws.Activate
  Application.ScreenUpdating = True
End Sub
Regards
Get a bug, saying name allready exist.
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,658
May be this then:
Rich (BB code):
Sub Test1()
  Dim ws As Worksheet, n As String
  Set ws = ActiveSheet
  n = ws.Range("D1").Value
  If Len(n) = 0 Then
    MsgBox "D1 is empty", vbCritical, "Exit"
    Exit Sub
  End If
  Application.ScreenUpdating = False
  ws.Copy After:=Worksheets(Sheets.Count)
  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets(n).Delete
  Application.DisplayAlerts = True
  Sheets(Sheets.Count).Name = n
  If Not ws Is Nothing Then ws.Activate
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub
The sheet's name in D1 should be valid, of course.
 
Last edited:

Rasmusjc

New Member
Joined
Jul 29, 2018
Messages
18
Thanks Vladimir

That did it :biggrin:

Now everything is set for 2019.

Im very pleased with the help in here. I will be saving a lot of time in the future.

So thanks to all of you, who are taking your time to help.
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,658
Happy to know the issue is solved and thank you for the feedback! :)
 

Rasmusjc

New Member
Joined
Jul 29, 2018
Messages
18
Hi Vladimir

Im having issus with the code you helped me with.

Just to point out how it works.

If i push the "Safe to pdf" button:

1) The sheet "prisliste" then copy it self to a new sheet with the name in "D1".
2) 3 sheets "tilbud" "lejekontrakt" "faktura" saves as pdf in different folders.
3) The "prisliste" "tilbud" "lejekontrakt" and "faktura" sheets copy to a new workbook with the name in D1 and D4

This works fine.

But if i change some of the data i the new created workbook to make new PDF files it open the original workbook and takes the data from this "prisliste" and not from the "prisliste" inside the new workbook.

Im not sure if its because the "Safe as pdf" macro not are beeing copied correctly or where the fault is.

Vladimir do you think you can help me with this, not sure if the easiest would be to upload the entire worksheet so you can se what i mean.

This is the code in the main workbook in the sheet "prisliste"

Code:
Private Sub GemsomPDF() 
 
Dim fName As String
With Worksheets("Prisliste")
    fName = ThisWorkbook.Worksheets("Prisliste").Range("D1").Value & ThisWorkbook.Worksheets("Prisliste").Range("E10").Value & ThisWorkbook.Worksheets("Prisliste").Range("D4").Value
End With
Worksheets("Tilbud").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\rasmus\Desktop\Fårvangtelt\2019\Tilbud\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
Worksheets("Lejekontrakt").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\rasmus\Desktop\Fårvangtelt\2019\Lejekontrakt\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
Worksheets("Faktura").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\rasmus\Desktop\Fårvangtelt\2019\Faktura\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            


  Dim ws As Worksheet, n As String
  Set ws = ActiveSheet
  n = ws.Range("D1").Value
  If Len(n) = 0 Then
    MsgBox "D1 is empty", vbCritical, "Exit"
    Exit Sub
  End If
  Application.ScreenUpdating = False
  ws.Copy After:=Worksheets(Sheets.Count)
  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets(n).Delete
  Application.DisplayAlerts = True
  Sheets(Sheets.Count).Name = n
  If Not ws Is Nothing Then ws.Activate
  On Error GoTo 0
  Application.ScreenUpdating = True


            
    Sheets(Array("Prisliste", "Tilbud", "Lejekontrakt", "Faktura")).Copy
    'there is now a new active workbook
    With ActiveWorkbook
        'save it
        .SaveAs Filename:= _
        "C:\Users\rasmus\Desktop\Fårvangtelt\2019\" & ThisWorkbook.Worksheets("Prisliste").Range("D1").Value & ThisWorkbook.Worksheets("Prisliste").Range("E10").Value & ThisWorkbook.Worksheets("Prisliste").Range("D4").Value, FileFormat:=52
        'optionally close it
        .Close savechanges:=True
    End With
 

Forum statistics

Threads
1,082,243
Messages
5,363,972
Members
400,772
Latest member
solbebe

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top