+ Reply to Thread
Results 1 to 3 of 3

SaveAs not working

Hybrid View

  1. #1
    Registered User
    Join Date
    08-19-2004
    Posts
    60

    SaveAs not working

    Hi,

    Bit of elongated code here but after hours of trying i have nearly given up!, This code takes a file, copies some stuff to a new file and the saves it in a directory (or so i'd hope).

    It keeps falling over on the:

    bk.SaveAs Filename:=Range("E3").Select

    line at the end.

    Any help would be superb.

    thanks

    James

    Sub ExtractTrustData()
    Sheets("DNA").Select
    Sheets("DNA").Range("C3:C396").Select
    Dim TrustRef As Range
    
    For Each TrustRef In Selection
      TrustRef.Copy
      Workbooks.Add 'add new workbook to copy data into
      Dim bk As Workbook
      Dim FlFormat As String
      Dim SaveNameAs As String
      Range("D2").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False  'paste trust reference
      
      Range("D3").Select
      ActiveCell.FormulaR1C1 = _
            "=VLOOKUP(R2C4,'[SMS Trust Data.xls]DNA'!R3C3:R396C37,ROW()-1,0)"  'vlookup trust ref and get other data
      Range("E3").Select
      ActiveCell.FormulaR1C1 = _
            "=""C:\JamesRyan"" & R3C4 "  'insert filename to save as
      Selection.Font.ColorIndex = 2
      Range("D3").Select
      Selection.Copy
        Range("D4:D36").Select
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False  'copy lookup formula downwards
        Range("A1").Select
        Application.CutCopyMode = False
      
      ActiveWindow.ActivateNext
        Sheets("Info").Select
        Range("A1:B35").Select  'copy in headings and titles
        Selection.Copy
        ActiveWindow.ActivateNext
        Range("B2").Select
        ActiveSheet.Paste
        
        Columns("A:D").Select
        With Selection.Font  'change all fonts to arial
            .Name = "Arial"
            .ColorIndex = xlAutomatic
        End With
        With Selection.Font  'change all font sizes to 8
            .Name = "Arial"
            .Size = 8
            .ColorIndex = xlAutomatic
        End With
        
        Columns("D:D").Select
        Selection.Style = "Comma"
        Selection.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"  'put all numbers in accounting style
        Range("B2:D4,B5:D8,B9:D12,B13:D16,B17:D20,B21:D24,B25:D28,B29:D32,B33:D36"). _
            Select
        
        Range("B33").Activate
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone  'put main borders on cells
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        
        Selection.Borders(xlInsideVertical).LineStyle = xlNone  'put borders on top cells
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("B5:D8,B21:D24").Select
        
        Range("B21").Activate
        With Selection.Interior  'start colouring cells
            .ColorIndex = 35
            .Pattern = xlSolid
        End With
        Range("B9:D12,B25:D28").Select
        Range("B25").Activate
        With Selection.Interior
            .ColorIndex = 22
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
        Range("B13:D16,B29:D32").Select
        Range("B29").Activate
        With Selection.Interior
            .ColorIndex = 37
            .Pattern = xlSolid
        End With
        Range("B17:D20,B33:D36").Select
        Range("B33").Activate
        With Selection.Interior
            .ColorIndex = 36
            .Pattern = xlSolid
        End With
        Range("B2:D4").Select
        With Selection.Interior
            .ColorIndex = 15
            .Pattern = xlSolid
        End With  'end colouring cells
        Selection.Font.Bold = True
        Columns("B:D").Select
        
        Columns("B:D").EntireColumn.AutoFit  'autofit all columns
        Range("B5:B36").Select  'start bordering titles
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With  'end bordering titles
        
        Range("C5:D8,C9:D12,C13:D16,C17:D20,C21:D24,C25:D28,C29:D32,C33:D36").Select  'start bordering inside lines
        Range("C33").Activate
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With  'end bordering inside lines
        
        ActiveWindow.ActivateNext  'start copying table of information required
        Sheets("Info").Select
        Range("A37:B41").Select
        Selection.Copy
        ActiveWindow.ActivateNext
        Range("B38").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone  'end copying of table of information required
        
        Columns("F:F").Select  'hide other columns and rows
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.ColumnWidth = 0
        Rows("44:44").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.RowHeight = 0
        
        SaveNameAs = E5 'name cell for filename
        FlFormat = ActiveWorkbook.FileFormat
        bk.SaveAs Filename:=Range("E3").Select
        bk.Saved = True
        bk.Close
        
    Next
    End Sub

  2. #2
    Forum Expert royUK's Avatar
    Join Date
    11-18-2003
    Location
    Derbyshire,UK
    MS-Off Ver
    Xp; 2007; 2010
    Posts
    26,200
    It should be something like this

    bk.SaveAs Filename:=Range("E3").Value & ".xls"
    I'm not sure why you have this line

    SaveNameAs = E5 'name cell for filename
    but it should be

     SaveNameAs = Range("E5").Value'name cell for filename
    Maybe
     SaveNameAs = Range("E5").Value &".xls"'name cell for filename
    bk.SaveAs Filename:=SaveNameAs
    Hope that helps.

    RoyUK
    --------
    For Excel Tips & Solutions, free examples and tutorials why not check out my web site

    Free DataBaseForm example

  3. #3
    Registered User
    Join Date
    08-19-2004
    Posts
    60
    cheers Roy,

    will test it in the morning to see if it works with that,

    still working my way through VB so i know my code could do with a lot of cleaning up!

    James

+ 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