エクセルマクロをすこし 2018年8月13日 その2

シート名変更Ok

Sub yy()
Application.ScreenUpdating = False
SC = ActiveWorkbook.Sheets.Count
Ye = Year(Date) & "年"
Mo = Month(Date) & "月"
Da = Day(Date) & "日"
i = 1
Do While i <= SC
Worksheets(i).Copy
Filename = Range("J5") & Ye & Mo & Da
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\" & Filename & ".xlsx"
.Close
End With
PrintCommunication = False
With ActiveSheet.PageSetup
.PrintArea = Range("A1:G29").Address
.Zoom = 80
.PaperSize = xlPaperA4
.CenterHorizontally = True
.CenterVertically = True
.LeftMargin = Application.CentimetersToPoints(0.8)
.RightMargin = Application.CentimetersToPoints(0.8)
End With
PrintCommunication = True
ActiveSheet.Name = Range("J5") & Ye & Mo & Da
ActiveWorkbook.Save
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub