sDirDefault = ":\Profit Centres\Royal Mail 2011 Contract\Internal\Mail Centre Products\CODOL ISSUE June 2015\Pans Updated LATs\Call Lists"

 

cDrive = Left((ThisWorkbook.Path), 1)

ChDrive Left((ThisWorkbook.Path), 1)

ChDir (cDrive & sDirDefault)

 

tsqlfile = Application.GetSaveAsFilename("Pan Updated LATs Call list YYYYMMDD - SQL result.xlsx", Title:="Please Save Your file")

    If tsqlfile = False Then

        MsgBox ("You Must choose a name to save a file")

        Exit Sub

    End If

    

 

    lTasks = "LAT Tasks.xlsm"

 

 Workbooks(lTasks).Sheets("All Data").Activate

 Range("a1").CurrentRegion.Copy

 

Workbooks.Add

Sheets(1).Name = Format(Date, "DD MMMM")

Range("a1").PasteSpecial xlPasteAll

 

 

ActiveWorkbook.SaveAs tsqlfile

ActiveWorkbook.Close savechanges = True