VBA autosave with name in 2cells

[johnphilips]

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

 

[John_w]

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.

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]

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.

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]

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]

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]

Replace the Workbook_BeforeClose with this version:

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]

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.