Private WithEvents app As Application Private Sub Workbook_Open() Set app = Application End Sub Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) ' add the footers to each sheet when the workbook is saved ' check the author of the workbook For Each p In Wb.BuiltinDocumentProperties If p.Name = "Author" Then ' if the author matches continue to add the footers to each sheet If p.Value = Application.UserName Then Dim sht As Worksheet For Each sht In Wb.Sheets With sht.PageSetup If .RightFooter = "" Then ' do not overwrite an existing footer .RightFooter = "Right footer text!!" End If If .LeftFooter = "" Then .LeftFooter = "Left footer text!!" End If If .CenterFooter = "" Then .CenterFooter = "Center footer text!!" End If End With Next End If Exit Sub End If Next End Sub