Save 2 Worksheets(Sheet2 and Sheet3) As New File To Specific Folder

k0st4din

New member
Joined
Aug 7, 2012
Messages
6
Reaction score
0
Points
0
Location
BG, London
Hello everyone,
I posted my question on this site(Save 2 Sheet's - criteria in a particular cell - VBA Express Forum)and here (http://www.excelfox.com/forum/f2/save-worksheets-as-new-file-to-specific-folder-1064/), 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.
In the second site gave me some suggestions but still can not get to the end and get that I need.
Code:
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)
        [B]wbkNew.SaveAs strDesktopFolder & "[B]C:\Users\dracon_\Desktop\Countries[/B]" & strCity & "\" & strFName, 51[/B]'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
 

Attachments

  • Book1.xls
    47 KB · Views: 20
Back
Top