Change a Cell based on a List and Save the Worksheet with that Cell Name

[ricardo9316]

So I haev the following VBA, pretty staright forward code to perfomr a Save As with the name in A1. But I would like for A1 to change "as a data validation/list" based on a list that I have (say: D1:D10) and save the Worksheet with the Cell value Name for each of the 10 records.


Sub SaveAsExample()


Dim FName As String
Dim FPath As String

FPath = "Z:\Ricardo"
FName = Sheets("Sheet1").Range("A1").Text
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName


End Sub

 

[Fishboy]

Try this on for size...

Sub MultiSaveFilter()
' Define variables
Dim Cell As Range, cRange As Range, fRange As Range, FPath As String
' Set desired file path
FPath = "Z:\Ricardo"
' Set range to check for desired filenames
Set cRange = Sheets("Sheet2").Range("D1:D10")
' Set fRange as Sheet1 A1 to drive the filter
Set fRange = Sheets("Sheet1").Range("A1")
' Disable screen updating to reduce flicker
Application.ScreenUpdating = False
' For each cell in check range
For Each Cell In cRange
' Change the value of A1 to the cell value to drive the filter
    fRange.Value = Cell.Value
' Save workbook to specified file path using the cell value as filename
        ThisWorkbook.SaveCopyAs Filename:=FPath & "\" & fRange.Value & ".xlsm"
' Move to next cell in cRange
Next Cell
' Re-enable screen updating
Application.ScreenUpdating = True
' Clear contents of A1 to clear filter
fRange.ClearContents
End Sub