VBA autosave with name in 2cells

johnphilips

New Member
Joined
Jan 22, 2013
Messages
11
Hi all

I have been suching the net for a VBA code. I have been looking for days and i have found nothing.

I'm working on a workingsheet that need to save before closing with the name reading from 2 cells. Either im Stupid or I haven't found a code for it. I have just start to learn all this. Pleas help me.

In one of the cells is a number and I have put in a macro. So evertime it opens it adds +1. Here the Marco i added:

Private Sub Workbook_Open()
Range("F1") = Range("F1") + 1
ActiveWorkbook.save
End Sub

Can anyone help me? :)

Regards john
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,906
I can see from your code that cell F1 contains the incrementing number, but you haven't said which cell contains the file name. In the code below I've assumed A1 (on Sheet1) contains the file name, for example "My workbook" without the quotes. The new workbook is saved in the same folder as the original workbook. Put this code in the ThisWorkbook module.
Code:
Private Sub Workbook_Open()
    With Sheets("Sheet1").Range("F1")
        .Value = .Value + 1
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim fileName As String
    
    With Sheets("Sheet1")
        fileName = .Range("A1").Value & .Range("F1").Value & ".xls"
    End With
    MsgBox fileName

    With ActiveWorkbook
        .SaveCopyAs fileName:=.Path & "\" & fileName
        .Save
    End With
End Sub
 

johnphilips

New Member
Joined
Jan 22, 2013
Messages
11
I can see from your code that cell F1 contains the incrementing number, but you haven't said which cell contains the file name. In the code below I've assumed A1 (on Sheet1) contains the file name, for example "My workbook" without the quotes. The new workbook is saved in the same folder as the original workbook. Put this code in the ThisWorkbook module.
Code:
Private Sub Workbook_Open()
    With Sheets("Sheet1").Range("F1")
        .Value = .Value + 1
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim fileName As String
    
    With Sheets("Sheet1")
        fileName = .Range("A1").Value & .Range("F1").Value & ".xls"
    End With
    MsgBox fileName

    With ActiveWorkbook
        .SaveCopyAs fileName:=.Path & "\" & fileName
        .Save
    End With
End Sub

With these codes I have errors when closing Run-time error '9':
Subscript out of range

When opening Run-time error '-21447352565 (8002000b)':

Can't move focus to the control because it invisible, not enabled, or of a type that does not accept the focus.

thank you for your help.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,906
Is the sheet for the relevant cells A1 and F1 named "Sheet1"? If not, change "Sheet1" in the code accordingly.

I've also assumed you want to save the workbooks with the .xls extension. Again, change this part of the code if you want to save as .xlsm instead.
 

johnphilips

New Member
Joined
Jan 22, 2013
Messages
11

ADVERTISEMENT

No it's called tabelle1 and where do i put in the place where it should be saved.
and the A1 should be A9.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,906
Replace the Workbook_BeforeClose with this version:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim nextFileName As String
    
    With Sheets("Sheet1")
        nextFileName = "C:\path\to\folder\" & .Range("A9").Value & " " & .Range("F1").Value & ".xls"
    End With
    MsgBox nextFileName

    With ActiveWorkbook
        .SaveCopyAs fileName:=nextFileName
        .Save
    End With
End Sub
Edit the folder path as appropriate, keeping the trailing \.
 

johnphilips

New Member
Joined
Jan 22, 2013
Messages
11
HI
The code is ok but i would like it to be able to saved it so the name changes before/during I use the commandbutton for the email.

Private SubButton5_Click()
ActiveWorkbook.SaveAs "C:\VBA Code\SendMailExample.xls"
ActiveWorkbook.SendMail Recipients:="g5g5g@hotmail.com", _
Subject:="SendMailExample"
If Workbooks.Count > 1 Then
If MsgBox("All workbook changes will be lost." & _
vbNewLine & vbNewLine & "Do you want to continue?", _
vbYesNo + vbCritical) = vbYes Then
Application.DisplayAlerts = False
Application.Quit
Else
ActiveWorkbook.Close SaveChanges:=False
End If
Else
Application.DisplayAlerts = False
Application.Quit
End If
End Sub
End Sub


Or is there another code that you could help me with.
 

Forum statistics

Threads
1,137,154
Messages
5,679,914
Members
419,862
Latest member
Bluewings666

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top