Save Worksheets As New File To Specific Folder

[k0st4din]

Hello everyone,
I posted my question on this site(Save 2 Sheet's - criteria in a particular cell - VBA Express Forum (http://www.vbaexpress.com/forum/showthread.php?t=46426)), but so far no one can give me an answer. Why I write here in the hope someone can help me.
After much searching on the internet, I still have not managed to find a solution to my problem.
So I turn to you, great minds with the hope you can help me.
That is the difficulty with which I can do:
On the desktop I have a folder with a name in it I have 70 folders with names of cities, have 1 excel file with 3 sheets (sheet1 (it manage all actions (macros) that I have), sheet2 and sheet3), - my problem is how to make a macro to a button placed on sheet1 and when I press this button to check the macro cell C5 in Sheet2 and depending on which city is written in cell C5, let me open the folder on the desktop and then the folder name of the city to allow me to write the title of the new file and my copy two sheets (Sheet2 and Sheet3).
I will try to simplify it with an example:
1 workbook - example name Countries
3 sheets - Sheet1 - permanent, sheet2 and Sheet3 - create a button macro in Sheet1.
in Sheet2 - Documentary write things and the most important is my cell C5, which set the town.
in Sheet3 - write in many cells, names, addresses, workplaces, and many other things.
Back in sheet1 - I have my button.
Press the button and the macro (here is the big problem) examine cell C5 in sheet2, dialog box opens (I mean Save as ........) (but I've already put in the macro path to the folder "Countries" and he should find a folder with the name of the city that is in cell C5, and open the folder) I wrote a title and pressing Save - Sheet2 and Sheet3 already be present in the folder and they're so each subsequent time.
I hope you understand me, I tried to explain it in the easiest possible way.
Thank you in advance!
I found this macro, which is roughly good, but you'll have to change it after you save the new file name can be set to open a folder on the desktop and automatically find the folder with the name of the city (taken from cell C5) and save it there.

Option Explicit
Sub TwoSheetsAndYourOut()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet

If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
With Application
.ScreenUpdating = False

' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error Goto ErrCatcher
Sheets(Array("Sheet2", "Sheet3")).Copy
On Error Goto 0

' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select

' Remove named ranges
For Each nm In ActiveWorkbook.Names
nm.Delete
Next nm

' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

' Save it with the NewName and in the same directory as original.
' I am referring here to make a change, ie once
' I set my path to desktop - how then to automatically find the name of the city and there to save?
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls" 'perhaps to use it or something else -> strName = Range("C5") ActiveWorkbook.SaveAs Filename:= ThisWorkbook.Path & "\" & strName
ActiveWorkbook.Close SaveChanges:=False

.ScreenUpdating = True
End With
Exit Sub

ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub

[Admin]

Hi

try this


Option Explicit

Sub kTest()

Dim strDesktopFolder As String
Dim strCity As String
Dim wbkActive As Workbook
Dim wbkNew As Workbook
Dim strFName As String

strDesktopFolder = CreateObject("WScript.Shell").Specialfolders(10)

strCity = ThisWorkbook.Worksheets("Sheet2").Range("c5")
1:
If CBool(Len(Dir(strDesktopFolder & "\" & strCity, vbDirectory))) Then
Set wbkActive = ThisWorkbook
Set wbkNew = Workbooks.Add(xlWBATWorksheet)
wbkActive.Worksheets(Array("Sheet2", "Sheet3")).Copy before:=wbkNew.Worksheets(1)
strFName = Application.InputBox("File Name", "FileName", Type:=2)
wbkNew.SaveAs strDesktopFolder & "\" & strCity & "\" & strFName, 51
wbkNew.Close 0
Set wbkNew = Nothing
Else
If MsgBox("Folder '" & strDesktopFolder & "\" & strCity & "' does not exist." & vbLf & _
"Do you want create the folder?", vbYesNo) = vbYes Then
MkDir strDesktopFolder & "\" & strCity
GoTo 1
Else
Exit Sub
End If
End If

End Sub

[k0st4din]

Hello,
thank you very much for your cooperation on your part.
Maybe I wrong somewhere and therefore attach files and pictures to make clear what I mean. I hope you can understand me more clearly what I need, having in mind that this is only an example.
I will try to explain:
I want to just copy Sheet2 and Sheet3.
1 - write all sorts of things, but the most important is the cell C5 - if there is the city of London.
2 - Press the button in Sheet1.
3 - shows a window in which to write my name (title of the new workbook)
4 - automatically finds the folder (in this example "States" - can himself to show the path to it in the macro)
5 - According to the city in cell C5 - opens the folder and there save the new workbook with the name written by me. (in the present case because it keeps on the old document)
Here is link to download samples -> DOX.bg - (http://dox.bg/files/dw?a=6bc51cf045)

[Admin]

Hi

Have you tried the code?

[k0st4din]

Hello Admin,
I tried to do, and that is why I wrote again with a little more clarification.
Again and again I repeat that I could be wrong somewhere, but the code does the following: climbing inscription to ask me the title, I write as 123 and he took the name from cell C5 makes my folder of the state and within her again the same name (of excel file) the cell C5. In other words: If you have London in cell C5 - make folder London and excel file is also London. If you change the data in the cells, but the city is again the same, then replace it on the old excel file, and I do not want so, and when climbing allows me to me to ask myself the title of the excel file and according to the country to save it in folder.
I beg you look at the attached photos.
Greetings and thank you very much!

[Admin]

Hi

replace this line


wbkNew.SaveAs strDesktopFolder & "\" & strCity & "\" & strCity, 51

with


wbkNew.SaveAs strDesktopFolder & "\" & strCity & "\" & strFName, 51

[k0st4din]

Hello Admin,
receive and now everything is fine.
if you can tell me where wrong with putting the path to my folder because everything I saved on the desktop, but I want to ask him a path to my folder. I'll show you what I do, but I do not get things right.


Option Explicit

Sub kTest()

Dim strDesktopFolder As String
Dim strCity As String
Dim wbkActive As Workbook
Dim wbkNew As Workbook
Dim strFName As String

strDesktopFolder = CreateObject("WScript.Shell").Specialfolders(10)

strCity = ThisWorkbook.Worksheets("Sheet2").Range("c5")
1:
If CBool(Len(Dir(strDesktopFolder & "\" & strCity, vbDirectory))) Then
Set wbkActive = ThisWorkbook
Set wbkNew = Workbooks.Add(xlWBATWorksheet)
wbkActive.Worksheets(Array("Sheet2", "Sheet3")).Copy before:=wbkNew.Worksheets(1)
strFName = Application.InputBox("File Name", "FileName", Type:=2)
wbkNew.SaveAs strDesktopFolder & "C:\Users\dracon_\Desktop\Countries" & strCity & "\" & strFName, 51'I put my path to the folder but does
' not want to get probably
' wrong again!? Please help me.
' My heartfelt thanks!
wbkNew.Close 0
Set wbkNew = Nothing
Else
If MsgBox("Folder '" & strDesktopFolder & "\" & strCity & "' does not exist." & vbLf & _
"Do you want create the folder?", vbYesNo) = vbYes Then
MkDir strDesktopFolder & "\" & strCity
GoTo 1
Else
Exit Sub
End If
End If

End Sub

[Admin]

Hi

try this.



Option Explicit

Sub kTest()

Dim strDesktopFolder As String
Dim strCity As String
Dim wbkActive As Workbook
Dim wbkNew As Workbook
Dim strFName As String

'strDesktopFolder = CreateObject("WScript.Shell").Specialfolders(10)

Dim strFolderToSave As String

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
strFolderToSave = .SelectedItems(1)
Else
'no folder selected
Exit Sub
End If
End With

strCity = ThisWorkbook.Worksheets("Sheet2").Range("c5")

Set wbkActive = ThisWorkbook
Set wbkNew = Workbooks.Add(xlWBATWorksheet)
wbkActive.Worksheets(Array("Sheet2", "Sheet3")).Copy before:=wbkNew.Worksheets(1)
strFName = Application.InputBox("File Name", "FileName", Type:=2)
'wbkNew.SaveAs strDesktopFolder & "C:\Users\dracon_\Desktop\Countries" & strCity & "\" & strFName, 51 'I put my path to the folder but does
wbkNew.SaveAs strFolderToSave & "\" & strFName, 51
' not want to get probably
' wrong again!? Please help me.
' My heartfelt thanks!
wbkNew.Close 0
Set wbkNew = Nothing

End Sub

[k0st4din]

Hello Admin,
mistake somewhere in the code, there is something that we can not understand or I did not explain it or you can not understand. I will try to explain again.
1 - Press the button in sheet1
2 - window pops up and asks how to say your file?
3 - Automatically finds the path (or leave me a place in the code where I give myself a way) to a folder Countries
4 - and then by the city of Sheet2, cell 5 to automatically save it in the folder with the name of the city, but what I wrote title (2 *)
I hope this time we can to do that.
I am most grateful for the work of your hand.

[Admin]

Hi

Like this ?


Option Explicit

Sub kTest()

Dim strDesktopFolder As String
Dim strCity As String
Dim wbkActive As Workbook
Dim wbkNew As Workbook
Dim strFName As String

'strDesktopFolder = CreateObject("WScript.Shell").Specialfolders(10)

Dim strFolderToSave As String

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
strFolderToSave = .SelectedItems(1)
Else
'no folder selected
Exit Sub
End If
End With

strCity = ThisWorkbook.Worksheets("Sheet2").Range("c5")

Set wbkActive = ThisWorkbook
Set wbkNew = Workbooks.Add(xlWBATWorksheet)
wbkActive.Worksheets(Array("Sheet2", "Sheet3")).Copy before:=wbkNew.Worksheets(1)
strFName = strCity ' Application.InputBox("File Name", "FileName", Type:=2)
wbkNew.SaveAs strFolderToSave & "\" & strFName, 51
wbkNew.Close 0

Set wbkNew = Nothing

End Sub

[k0st4din]

No, no, no, no, my friend somewhere or confuse me or you.
I beg you make a folder on the desktop that says countries "do it 3 more folders 1st - London, 2 nd - Paris 3rd - Sofia.
Write in Sheet2 cell C5 eg London, go on Sheet1 press the button and let me jump out the window and ask for the name of the excel file and write something after clicking "OK" you should be able to see the excel file in a folder London, not elsewhere.
C \ Users \ .......... \ Desktop \ Countris \ - and get here already excel file are able to find the folder according to his city from cell C5
Beginning to despair!
Regards

[k0st4din]

Hello Mr. Admin,
we want to finish my problem?
I do not know if you know, but you're the only present that reached almost to the end!
Please help me!
Thank you again and again!

[Admin]

Hi

Sorry for the late reply. See Post # 2 (http://www.excelfox.com/forum/f2/save-worksheets-as-new-file-to-specific-folder-1064-post4794/#post4794)

[k0st4din]

839
840
842
841

The code works, but needs a little change. Please look at pictures or see post *11

[Admin]

Sorry, but I could not understand your query :confused:

I already provided 2 solutions, one, to select a folder via a dialog and the other one, folder with city name on the desktop.
Not sure what do you want now.

[k0st4din]

Hi Admin
First, I am very grateful for your help.
Second showed many examples only for this macro are able to find the root folder in my example State) and then find the folder Cities.
Ie I do not want to do things on my desktop, and make them in my chosen folder - automatic, ie a macro.
I say the macro works fine, but each folder look for her clicking until he came to it (it's in the second case).
Let's write it again:
You've got your desktop.
Of it (the desktop) you have 1 folder named countries.
in this folder countries have more than 70 folders with names of cities.
Problem: how like punched in sheet1 (activation of macro) automatically find the folder (countries)?
It should - according to the city from cell C5 in Sheet2 - automatically finds the city and remains only for me to write the title of the excel file!
I'm sure you can do it, the question is whether we can find the correct words

[Admin]

To save file in the country folder within folder 'countries' on desktop, try


wbkNew.SaveAs strDesktopFolder & "\Countries\" & strCity & "\" & strFName, 51

[k0st4din]

You are God, that's what I had in mind.
Now we knew Dear God (admin) could help me.
Here's where the problem was - I laid all the way to the folder and it should have and just put her name
Infinitely thank you Admin!
Thank you, thank you, thank you!
:notworthy::thumbsup::notworthy:

[Admin]

Thanks for the nice comments. :cheers: