CODEWITHSUNDEEP
vbaexcelmacros
ShizukaNaHaji
ShizukaNaHaji

Reputation: 1593

Excel Macro to save

I know i should probably be doing this in access or VB but I dont know how to use either. At the moment I have a submit button at the end of my form that saves and closes the workbook as whatever is inputted to a certain cell.

I am looking for a way to be able to do the same thing but break the worksheet out of the workbook. So it saves just the worksheet as its own excel file and with the name inputted into a certain cell. Below is the macro I am currently using.

Sub Saveworkbook()
Application.DisplayAlerts = False
Dim dName$, vName$
    dName = Range("B8")
    vName = ActiveWorkbook.FullName
    ActiveWorkbook.SaveAs "W:\Test\" & dName
    ActiveWorkbook.SaveAs vName
    ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

It would also be cool if it could add the date and computers user in to save name but not essential.

Thanks in advance Sam

Upvotes: 0

Views: 153

Answers (2)

TsTeaTime
TsTeaTime

Reputation: 921

This code will save any changes you have created in the current version, then it will save just the Active Sheet as a new workbook with the username and date (Credit to @Will on the Environment Variables).

Sub Saveworkbook()
Application.DisplayAlerts = False
Dim Sheet1 As Worksheet
Dim dName$, vName$, sName$
    dName = Range("B8")
    vName = ActiveWorkbook.FullName
    sName = ActiveWorkbook.ActiveSheet.Name
    For Each Sheet1 In ActiveWorkbook.Sheets
    If Not Sheet1.Name = sName Then
    Sheet1.Delete
    End If
    Next Sheet1

    ActiveWorkbook.SaveAs "W:\Test\" & dName & "_" & Environ("username") & "_" & Format(Now, "ddmmyy") & "xlsx"
    ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

Upvotes: 1

user6028892
user6028892

Reputation:

Something like this - 

Sub SaveSheet()

Dim wbkDashboard As Workbook
Dim wsTarget As Worksheet
Set wsTarget = Thisworkbook.worksheets("Sheet1")

Dim strFileName As String
strFileName = wsTarget.Range("B8").Value _
    & Format(Now, "ddmmyyyy") & "-" & Environ("username") & ".xlsx"

Set wbkDashboard = Workbooks.Add
wsTarget .Copy Before:=wbkDashboard.Sheets(1)

For intSheetCount = 2 To wbkDashboard.Sheets.Count
    wbkDashboard.Sheets(2).Delete
Next

wbkDashboard.SaveAs "W:\Test\" & wsTarget.Range("B8").Value  _
    & Format(Now, "ddmmyyyy") & "-" & Environ("username") & ".xlsx"

wbkDashboard.Close
wsTarget.Range("B8").Value= strFileName

Set wsTarget = Nothing
Set wbkDashboard = Nothing
End Sub

Upvotes: 3

Related Questions