File Not Saving

[Skybluekid]

Hi All,

I am using the below code:

Sub SaveSheetasFile()

Dim Masterfile As Workbook
Dim NewWb As Workbook
Dim Rng As Range
Dim Filename As String

Set Masterfile = ThisWorkbook
Set NewWb = Workbooks.Add
Set Rng = Masterfile.Sheets(2).Range("B2:K41")

Filename = "FakePath & Masterfile.Sheets(2).Range("R2").Text

'Copy Range and Paste onto ActiveSheet
Rng.Copy Destination:=NewWb.Sheets(1).Range("B2")

'Adjust Columns
Columns("B").ColumnWidth = 9.71
Columns("C").ColumnWidth = 9.71
Columns("D").ColumnWidth = 12.14
Columns("E").ColumnWidth = 12.71
Columns("F").ColumnWidth = 11.29
Columns("G").ColumnWidth = 36.29
Columns("H").ColumnWidth = 52.86
Columns("I").ColumnWidth = 11.57
Columns("J").ColumnWidth = 10.57
Columns("K").ColumnWidth = 21.14

ActiveSheet.Shapes.Range(Array("Picture 5")).Select
    Selection.ShapeRange.ScaleWidth 1.0687910655, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.4065694608, msoFalse, msoScaleFromTopLeft
   
With ActiveWorkbook
    .SaveAs Filename, xlOpenXMLWorkbook
    .Close
End With

End Sub

It works until until I get to save the file, where is comes up with a Runtime Error 1004 Method 'Save As' of Object'_Workbook' Failed

I have looked at everything I can think of, but with no joy.

Any help would be appreciated

Thanks in Advance

 

[NdNoviceHlp]

I'm guessing....

Filename = "FakePath & "\" & Masterfile.Sheets(2).Range("R2").Text

HTH. Dave