Create New Workbook

[fari1]

I want to save as my active sheet of current workbook as new file and new file name would be the Cell reference of active sheet.
this is urgent, waiting anxiously for the response plz

 

[VoG]

Try

Sub NewWB()
ActiveSheet.Copy
With ActiveWorkbook
    .SaveAs Filename:=ActiveSheet.Name & ".xls"
    .Close
End With
End Sub

 

[fari1]

hi vog, thanks for the reply, the sheet that it is copying, contains a macro, so it is asking if i want to say it as macro enabled workbook, so i want to get rid of this msg,as it would be macro free workbook. Also i want to name the file as "\Output&sheets(prof).range("C5").value_" & DateTime.Day(Now) & "_" & DateTime.Month(Now) & "_" & DateTime.Year(Now) & "--" & DateTime.Hour(Now) & "_" & DateTime.Minute(Now) & "_" & DateTime.Second(Now) & ".csv"

as the file created would be in csv format, also the file creation is the part of the loop, so i also want to add in the code that it must check if the file of that cell value name already exisits or not, if it does then simply replace the file, else create the new one.
i hope i didn't confuse u

 

[VoG]

Try like this

Sub NewWB()
Dim p As String, q As String
p = ActiveWorkbook.Path
q = Sheets("prof").Range("C5").Value
ActiveSheet.Copy
With ActiveWorkbook
    Application.DisplayAlerts = False
    .SaveAs Filename:=p & "\Output\" & q & Format(Now, "dd-mm-yy hh-ss") & ".csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    .Close
End With
End Sub

 

[fari1]

it is highlighting this part of the code

    .SaveAs Filename:=p & "\Output\" & q & Format(Now, "dd-mm-yy hh-ss") & ".csv", FileFormat:=xlCSV

method save as of worksheet object falied

 

[VoG]

Works for me. Does the subfolder Output exist?

 

[fari1]

Okayz, i didn't created the folder, i just created, yes it works, can't it create the folder by itself? just one time for the whole loop?
also it is asking if i want to save the changes in the new workbook? why is that so? and i asked u also that it must match the cell referece for the next save,if the file that includes that cell name already exists, then it must exit else create new one. is that possible?

 

[VoG]

Try this

Sub NewWB()
Dim p As String, q As String
p = ActiveWorkbook.Path
q = Sheets("prof").Range("C5").Value
If Not DirExists(p & "\Output") Then MkDir (p & "\Output")
ActiveSheet.Copy
With ActiveWorkbook
    Application.DisplayAlerts = False
    .SaveAs Filename:=p & "\Output\" & q & " " & Format(Now, "dd-mm-yy hh-ss") & ".csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    .Close savechanges:=True
End With
End Sub

 

[fari1]

If Not DirExists(p & "\Output") Then MkDir (p & "\Output")

its highlighting this part and saying function not defined

 

[VoG]

Oops! I accidentally didn't post the whole code

Sub NewWB()
Dim p As String, q As String
p = ActiveWorkbook.Path
q = Sheets("prof").Range("C5").Value
If Not DirExists(p & "\Output") Then MkDir (p & "\Output")
ActiveSheet.Copy
With ActiveWorkbook
    Application.DisplayAlerts = False
    .SaveAs Filename:=p & "\Output\" & q & " " & Format(Now, "dd-mm-yy hh-ss") & ".csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    .Close savechanges:=True
End With
End Sub

Function DirExists(SDirectory As String) As Boolean
If Dir(SDirectory, vbDirectory) <> "" Then DirExists = True
End Function