Saving cell ref file in cell ref folder

[JamieDuncan]

Im trying to create a macro that saves a file as a cell reference.
Also I want that file to be saved in a folder named after another cell reference.
And I want this folder to be created if it doesnt exist.

So for example i wish to run macro
msgbox appears, do you want to save as O:\Internal\Test\ *folder ref here* \ * file ref here*
and on clicking yes it does exactly that.

Unfortunately i dont know how to aim the file into the folder, any help would be most appreciated

Here is my code so far:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> SaveSheet()
<SPAN style="color:#007F00">'error trap</SPAN>
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> Etrap

<SPAN style="color:#00007F">Dim</SPAN> fname1
fname1 = Sheets("sheet1").Range("a1").Value
<SPAN style="color:#00007F">Dim</SPAN> fname2
fname2 = Sheets("sheet1").Range("a2").Value
<SPAN style="color:#00007F">Dim</SPAN> FilDir
FilDir = "O:\Internal\Test\"
<SPAN style="color:#007F00">'ask user to save</SPAN>
<SPAN style="color:#00007F">If</SPAN> MsgBox("Save new form as " & FilDir & fname2 & ".xls?", vbYesNo) = vbNo <SPAN style="color:#00007F">Then</SPAN>
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>

<SPAN style="color:#007F00">'check value of activecell</SPAN>
<SPAN style="color:#00007F">If</SPAN> fname2 = "" <SPAN style="color:#00007F">Then</SPAN>
MsgBox "Please enter reference number", vbInformation
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>

<SPAN style="color:#007F00">'copy activesheet to new workbook</SPAN>
Sheets("Sheet1").Copy

Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#007F00">'create destination directory if it doesnt already exist</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> FilePath, fs
FilePath = "O:\Internal\Test\"
<SPAN style="color:#00007F">Set</SPAN> fs = CreateObject("Scripting.FileSystemObject")
fs.createfolder (FilePath & fname2)

<SPAN style="color:#007F00">'save activebook as new workbook</SPAN>
ActiveWorkbook.SaveAs Filename:=fname1 & ".xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

<SPAN style="color:#007F00">'close new workbook ie. sheet just saved</SPAN>
ActiveWorkbook.Close
Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>

Etrap:

Beep
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

 

[JamieDuncan]

OK all debugged now,
Saves just as i like

Sub SaveSheet()

Dim filname
filname = Sheets("sheet1").Range("a1").Value
Dim foldname
foldname = Sheets("sheet1").Range("a2").Value
Dim FilDir, fs
FilDir = "O:\Internal\Test\"
Dim NewFilePath
NewFilePath = FilDir & foldname & "\"
Dim NewFilePath2
NewFilePath2 = FilDir & foldname
'ask user to save
If MsgBox("Save new form as " & FilDir & foldname & "\" & filname & ".xls?", vbYesNo) = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'check value of activecell
If foldname = "" Then
MsgBox "Please enter reference number", vbInformation
Exit Sub
End If

'create destination directory if it doesnt already exist
    If Dir(NewFilePath2, vbDirectory) = "" Then
        MkDir NewFilePath2
    End If

'copy activesheet to new workbook
Sheets("Sheet1").Copy

'save activebook as new workbook
SaveFile:
ActiveWorkbook.SaveAs (NewFilePath & filname & ".xls"), _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

'close new workbook ie. sheet just saved
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub