VBA - Save Specific Sheets as New Workbooks with File name corresponding to C5 from each sheet.

[AndrewDrewAndy]

I have a workbook with 10 active files, but I only need to save sheets ("Export 1", "Export 2", "Export 3", "Export 4", "Export 5"). I have a file path I want to save them in, but I cannot find a code to save each sheets filename to the .txt in each sheets' C5 cell (each sheet has a different person's name that the file needs to be saved as). It doesn't work to change the worksheet names because the file is active and changes ofte

 

[Fluff]

How about

Sub AndrewDrew()
    Dim Ary As Variant
    Dim i As Long
 
    Ary = Array("Export 1", "Export 2", "Export 3")
    For i = 0 To UBound(Ary)
        Sheets(Ary(i)).Copy
        With ActiveWorkbook
            .SaveAs "C:\Mrexcel\Test\" & Range("C5").Value, 51
            .Close False
        End With
    Next i
End Sub

Change path in red to suit and if you want them as macro enabled change the blue 51 to 52
Add the other sheets to the array

 

[Norie]

Perhaps something like this.

Sub SaveSheets()
Dim wbNew As Workbook
Dim ws As Worksheet
Dim arrSheets As Variant
Dim strFileName As String
Dim strPath As String
Dim idx As Long

    arrSheets = Array("Export 1", "Export 2", "Export 3", "Export 4", "Export 5")

    strPath = "C:\Test\"    

    For idx = LBound(arrSheets) To UBound(arrSheets)
        Set ws  = ThisWorkbook.Sheets(arrSheets(idx))
        strFileName = ws.Range("C5").Value
        ws.Copy
        Set wbNew = Application.Workbooks(Application.Workbooks.Count)
        Application.DisplayAlerts = False
        wbNew.SaveAs strPath & strFileName, FileFormat:=xlCSV

        wbNew.Close
        Application.DisplayAlerts = True
    Next idx

End Sub

Note, this code will save the sheets as CSV files - not sure if that's what you want.

 

[AndrewDrewAndy]

How about

Sub AndrewDrew()
    Dim Ary As Variant
    Dim i As Long

    Ary = Array("Export 1", "Export 2", "Export 3")
    For i = 0 To UBound(Ary)
        Sheets(Ary(i)).Copy
        With ActiveWorkbook
            .SaveAs "C:\Mrexcel\Test\" & Range("C5").Value, 51
            .Close False
        End With
    Next i
End Sub

Change path in red to suit and if you want them as macro enabled change the blue 51 to 52
Add the other sheets to the array

This seemed to run fine but when I go to my updated save location there are not apparent files. Thank you

 

[Fluff]

Did you put the final \ at the end of the path?

 

[Norie]

Oops, for some reason I thought you wanted to save the sheets as CSV files.

Sub SaveSheets()
Dim wbNew As Workbook
Dim ws As Worksheet
Dim arrSheets As Variant
Dim strFileName As String
Dim strPath As String
Dim idx As Long

    arrSheets = Array("Export 1", "Export 2", "Export 3", "Export 4", "Export 5")

    strPath = "C:\Test\"   ' change path to suit here

    For idx = LBound(arrSheets) To UBound(arrSheets)

        Set ws  = ThisWorkbook.Sheets(arrSheets(idx))

        strFileName = ws.Range("C5").Value

        ws.Copy

        Set wbNew = Application.Workbooks(Application.Workbooks.Count)

        wbNew.SaveAs strPath & strFileName, FileFormat:=ThisWorkbook.FileFormat

        wbNew.Close SaveChanges:=False

    Next idx

End Sub

 

[AndrewDrewAndy]

This worked! Thank you!

Is there a way to make the folder location linked to a cell on say sheet "Master Data" A1?

 

[AndrewDrewAndy]

This was my error. Thank you

 

[AndrewDrewAndy]

This seemed to run fine but when I go to my updated save location there are not apparent files. Thank you

This worked! Thank you!

Is there a way to make the folder location linked to a cell on say sheet "Master Data" A1?

 

[Fluff]

How about

Sub AndrewDrew()
    Dim Ary As Variant
    Dim i As Long
    Dim Pth As String
    
    Pth = Sheets("Master Data").Range("A1")
    If Not Right(Pth, 1) = "\" Then Pth = Pth & "\"
    Ary = Array("Export 1", "Export 2", "Export 4")
    For i = 0 To UBound(Ary)
        Sheets(Ary(i)).Copy
        With ActiveWorkbook
            .SaveAs Pth & Range("C5").Value, 51
            .Close False
        End With
    Next i
End Sub