Save Excel Sheet as PDF within margins via VBA

[Kobus1264]

Hi,

I am currently using a VBA code that I got of this site, made one or two adjustments to fit my needs, but the problem I am having is I want it to like shrink everything on the excel sheet to fit onto one PDF. As it is now it saves it as 4 - 5 pages and thus does not look good. Can someone help to alter the code so that it would print everything like onto one A4 page, ( as if setting it to "Fit to Page" in print setup ) and also I don't know if my margins are correctly coded here.

Sub Button1_Click()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = "C:\Sample\%Date%" & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveWorkbook.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
.PageSetup.Orientation = xlPortrait
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PaperSize = xlPaperA4
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.TopMargin = Application.CentimetersToPoints(0.5)
.BottomMargin = Application.CentimetersToPoints(0.5)
.HeaderMargin = Application.CentimetersToPoints(0.2)
.FooterMargin = Application.CentimetersToPoints(0.2)
End With
'save book in this folder
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFilePath _
& "\" & SheetName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
.Close SaveChanges:=False
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub