Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: Save Worksheets As New File To Specific Folder

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Member
    Join Date
    Nov 2012
    Posts
    47
    Rep Power
    0

    Save Worksheets As New File To Specific Folder

    Hello everyone,
    I posted my question on this site(Save 2 Sheet's - criteria in a particular cell - VBA Express Forum), 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.
    Code:
    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

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    try this

    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)
            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
    Last edited by Admin; 06-07-2013 at 10:17 AM.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  3. #3
    Member
    Join Date
    Nov 2012
    Posts
    47
    Rep Power
    0
    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 -

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Have you tried the code?
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  5. #5
    Member
    Join Date
    Nov 2012
    Posts
    47
    Rep Power
    0
    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!

  6. #6
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    replace this line

    Code:
    wbkNew.SaveAs strDesktopFolder & "\" & strCity & "\" & strCity, 51
    with

    Code:
    wbkNew.SaveAs strDesktopFolder & "\" & strCity & "\" & strFName, 51
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  7. #7
    Member
    Join Date
    Nov 2012
    Posts
    47
    Rep Power
    0
    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.
    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)
            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

  8. #8
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    try this.

    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)
        
        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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  9. #9
    Member
    Join Date
    Nov 2012
    Posts
    47
    Rep Power
    0
    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.

  10. #10
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    Like this ?

    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)
        
        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
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Save Processed Files Into Different Another Folder
    By DARSHANKmandya in forum Excel Help
    Replies: 1
    Last Post: 03-22-2013, 07:10 PM
  2. Replies: 1
    Last Post: 02-14-2013, 12:09 PM
  3. Save each Worksheets as Macro disabled workbooks
    By nickface in forum Excel Help
    Replies: 1
    Last Post: 01-28-2013, 07:47 AM
  4. Replies: 9
    Last Post: 12-04-2012, 09:45 PM
  5. Find Parent Folder From Given Folder / File Path
    By Excel Fox in forum Excel and VBA Tips and Tricks
    Replies: 1
    Last Post: 05-28-2011, 03:50 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •