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

vichat

New Member
Joined
Jun 12, 2018
Messages
1
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
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
See lines highlighted in Red for changes

Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,338
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top