+ Reply to Thread
Results 1 to 2 of 2

Saving a workbook - vba

  1. #1

    Saving a workbook - vba

    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


  2. #2
    Forum Contributor funkymonkUK's Avatar
    Join Date
    01-07-2005
    Location
    London, England
    Posts
    500
    I think it might do with excel only liking to save using specific characters and I dont think a / or \ is one of them that is why it has put and _ instead

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1