Sub Export()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
'Dim dt As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Reconcile")
Set wb2 = Workbooks.Add
Set ws2 = wb2.Worksheets("Sheet1")
'ws2.Name = "Reconcile" & Format(ws.Range("G2").Value, "dd-mm-yyyy")
ws2.Name = Left("Reconcile " & Replace(wb.Worksheets("Source").Range("A3").Text, ":", "."), 30)
ws.Columns("A:F").Copy Destination:=ws2.Columns("A:F")
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.Orientation = xlLandscape
'.Zoom = False ' Better included just in case!
.Zoom = 40 ' Better included just in case!
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Columns("A:F").EntireColumn.AutoFit
Application.DisplayAlerts = False
For Each ws1 In wb2.Worksheets
If ws1.Name <> ws2.Name Then ws1.Delete
Next ws1
'Make sure Listing folder exists
'dt = "TDC_" & ws.Range("B2").Value & ".xls"
dt = "\\04\FileServices\Document\DBD\Reports\Reconcile_" & Format(ws.Range("G2"), "dd-mm") & ".xls"
Application.DisplayAlerts = True
wb2.SaveAs dt
End Sub
|