Saving a excel workbook

[ThunStorm]

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

 

[Cindy M.]

Hi ThunStorm,

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

Your problem description is incomplete. Please state the exact nature
of the problem and what kind of help you expect. Also include
information on the versions of Office and Windows you're using.

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

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail