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