Stuck on macro - need to save as originalfilename.xls not name of file that holds macro

[vichat]

Hi there

First time post so please bear with me if I'm not using the correct terminology.

I have a large number of .csv workbooks that need to have columns hidden, a new column added, further info added, columns locked and then save as .xls file. I recorded a macro on the first workbook and it works with all other workbooks but wants to save as the name of the first workbook (Ver1.xlsm) rather than the current filename. Can anyone assist? I'm sure it's something simple but I am not very experienced with VBA and am at a loss as to how to fix it.

Also, if anyone can help with any additions so that this will convert all workbooks in a folder at once rather than having to do them individually that would be brilliant!

Many thanks
V


Code is:


Sub Macro1()
'
' Macro1 Macro
'
'
Range("A:F,H:J,M:M").Select
Range("M1").Activate
Selection.EntireColumn.Hidden = True
Columns("G:G").ColumnWidth = 11
Columns("O:O").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("K:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


Lines removed here for confidentiality.


Range("T6:T9").Select
With Selection.Font
.Name = "Calibri"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("T2:AA11").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("P:AA").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ChDir "\\user\H\username\Desktop\sheets"
ActiveWorkbook.SaveAs Filename:= _
"\\user\H\username\Desktop\sheets\Ver1.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

 

[alansidman]

See lines highlighted in Red for changes

Sub Macro1()
'
' Macro1 Macro
'
[COLOR=#ff0000]Dim fName As String[/COLOR]
[COLOR=#ff0000]fName = InputBox("What Name should this file be saved as, ie.  ABC.xlsm")[/COLOR]
Range("A:F,H:J,M:M").Select
Range("M1").Activate
Selection.EntireColumn.Hidden = True
Columns("G:G").ColumnWidth = 11
Columns("O:O").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("K:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With




Lines removed here for confidentiality.




Range("T6:T9").Select
With Selection.Font
.Name = "Calibri"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("T2:AA11").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("P:AA").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ChDir "\\user\H\username\Desktop\sheets"
ActiveWorkbook.SaveAs Filename:= _
[COLOR=#ff0000]"\\user\H\username\Desktop\sheets\" & fName,[/COLOR] _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub