Saving a workbook - vba

M

moda7884

Can someone please help me? I have most of the code working except
when I try to make a clean filename from a cell value. Ex: n/a turns
into n_a.xls


Sub SemiFinalMacro_CreditCollections()

Dim bk As Workbook, bk2 As Workbook
Dim sh As Worksheet
Set bk2 = Workbooks("Test Temp.xls")
ThisWorkbook.Activate
Set sh = Worksheets("Pivot")

'Pivot table items selected
For Each itm In _
sh.PivotTables("PivotTable3") _
.PivotFields("Lessee").PivotItems
s = itm.Value
sh.PivotTables("PivotTable3").PivotFields("Lessee").CurrentPage =
itm.Value
sh.Cells.Copy
Workbooks.Add
Set bk = ActiveWorkbook

'Paste cells from master sheets
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
bk2.Sheets("PD").Cells.Copy bk.Sheets("sheet2").Cells

'Rename sheets & Delete 3rd sheet
bk.Sheets("Sheet1").Name = "Summary"
bk.Sheets("Sheet2").Name = "PD"
Application.DisplayAlerts = False
bk.Sheets("Sheet3").Delete
Application.DisplayAlerts = True

'Delete the first eleven rows
bk.Sheets("Summary").Rows("1:11").Select
bk.Sheets("Summary").Range("A11").Activate
Selection.Delete Shift:=xlUp

'Copy company name to 2nd sheet
bk.Sheets("Summary").Range("B9").Copy _
bk.Sheets("PD").Range("F6:H6")
Application.CutCopyMode = False

'Create clean file name
bk.Sheets("Summary").Range("F1").Select
ActiveCell.FormulaR1C1 = "='Test
Templates.xls'!CleanFileName(R[8]C[-4])"
Selection.Copy
bk.Sheets("Summary").Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'Save the workbook by cell value
bk.SaveAs Filename:="C:\Test Data\" &
Worksheets("Summary").Range("F2").Value & ".xls"

'Hide the information cells
bk.Sheets("Summary").Range("F1:F2").Select
bk.Sheets("Summary").Range("F2").Activate
Selection.NumberFormat = ";;;"

'Close workbook
bk.Close SaveChanges:=False
ThisWorkbook.Activate
Next
End Sub

Public Function CleanFileName(fNameStr As String)
Dim i As Integer
Const NO_NO_STRING = "/'<|> *" 'Add or remove "no-no's"
For i = 1 To Len(NO_NO_STRING)
fNameStr = Application.WorksheetFunction.Substitute(fNameStr, _
Mid(NO_NO_STRING, i, 1), "_")
Next i
CleanFileName = fNameStr
End Function
 
F

funkymonkUK

I think it might do with excel only liking to save using specifi
characters and I dont think a / or \ is one of them that is why it ha
put and _ instea
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top