excelvba

Adding cell values, specific to each page, to each header


I'm trying to get my cover sheet header to display "Schedule", and each sheet's header after to display the date displayed in cell "a6", which is in cell "a6" on each sheet. The code I've been working on will only display 1 sheet's cell value ("schedule", from the cover sheet) across all sheets. I need each sheet to pull from it's own cell "a6" and display the value in the header. How can I accomplish this?

Sub printless()
    Application.PrintCommunication = False
    Dim wkst As Worksheet
        For Each wkst In ActiveWorkbook.Sheets
            With wkst.PageSetup
                .CenterHeader = "&B&36" & Range("a6").Value ''''''BOLD/SIZE36, PULLS VALUE FROM CELL A6 AND PUT IS IN HEADER
                .PrintArea = "$a$6:$bb$108"
                .LeftMargin = Application.InchesToPoints(0.25)
                .RightMargin = Application.InchesToPoints(0.25)
                .TopMargin = Application.InchesToPoints(0.6)
                .BottomMargin = Application.InchesToPoints(0.25)
                .HeaderMargin = Application.InchesToPoints(0.3)
                .FooterMargin = Application.InchesToPoints(0.3)
                .CenterHorizontally = True
                .CenterVertically = False
                .Orientation = xlPortrait
                .PaperSize = xlPaperLetter
                .Zoom = 46
            End With
        Next wkst
            With Worksheets("Cover Sheet").PageSetup
                .CenterHeader = "&B&36" & Range("a6").Value
                .PrintArea = "$b$1:$ac$52"
                .LeftMargin = Application.InchesToPoints(0.25)
                .RightMargin = Application.InchesToPoints(0.25)
                .TopMargin = Application.InchesToPoints(1)
                .BottomMargin = Application.InchesToPoints(0.25)
                .HeaderMargin = Application.InchesToPoints(0.3)
                .FooterMargin = Application.InchesToPoints(0.3)
                .CenterHorizontally = True
                .CenterVertically = False
                .Orientation = xlPortrait
                .PaperSize = xlPaperLetter
                .Zoom = 75
            End With
    Application.PrintCommunication = True
    ActiveWorkbook.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

Solution

  • Print Workbook

    Sub printless()
    
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        ' If it isn't, reference the workbook by name or use 'ActiveWorkbook'.
    
        Application.PrintCommunication = False
        
        Dim wkst As Worksheet
        
        For Each wkst In wb.Worksheets
            With wkst.PageSetup
                Select Case wkst.Name
                    Case "Cover Sheet"
                        .CenterHeader = "&B&36" & wkst.Range("A6").Value
                        .PrintArea = "$b$1:$ac$52"
                        .LeftMargin = Application.InchesToPoints(0.25)
                        .RightMargin = Application.InchesToPoints(0.25)
                        .TopMargin = Application.InchesToPoints(1)
                        .BottomMargin = Application.InchesToPoints(0.25)
                        .HeaderMargin = Application.InchesToPoints(0.3)
                        .FooterMargin = Application.InchesToPoints(0.3)
                        .CenterHorizontally = True
                        .CenterVertically = False
                        .Orientation = xlPortrait
                        .PaperSize = xlPaperLetter
                        .Zoom = 75
                    Case Else
                        .CenterHeader = "&B&36" & wkst.Range("A6").Value
                        .PrintArea = "$a$6:$bb$108"
                        .LeftMargin = Application.InchesToPoints(0.25)
                        .RightMargin = Application.InchesToPoints(0.25)
                        .TopMargin = Application.InchesToPoints(0.6)
                        .BottomMargin = Application.InchesToPoints(0.25)
                        .HeaderMargin = Application.InchesToPoints(0.3)
                        .FooterMargin = Application.InchesToPoints(0.3)
                        .CenterHorizontally = True
                        .CenterVertically = False
                        .Orientation = xlPortrait
                        .PaperSize = xlPaperLetter
                        .Zoom = 46
                End Select
            End With
        Next wkst
        
        Application.PrintCommunication = True
        
        wb.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    End Sub
    
    Sub printless()
    
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        ' If it isn't, reference the workbook by name or use 'ActiveWorkbook'.
    
        Application.PrintCommunication = False
        
        Dim wkst As Worksheet
        
        For Each wkst In wb.Worksheets
            With wkst.PageSetup
                .CenterHeader = "&B&36" & wkst.Range("A6").Value
                .LeftMargin = Application.InchesToPoints(0.25)
                .RightMargin = Application.InchesToPoints(0.25)
                .BottomMargin = Application.InchesToPoints(0.25)
                .HeaderMargin = Application.InchesToPoints(0.3)
                .FooterMargin = Application.InchesToPoints(0.3)
                .CenterHorizontally = True
                .CenterVertically = False
                .Orientation = xlPortrait
                .PaperSize = xlPaperLetter
                Select Case wkst.Name
                    Case "Cover Sheet"
                        .PrintArea = "$b$1:$ac$52"
                        .TopMargin = Application.InchesToPoints(1)
                        .Zoom = 75
                    Case Else
                        .PrintArea = "$a$6:$bb$108"
                        .TopMargin = Application.InchesToPoints(0.6)
                        .Zoom = 46
                End Select
            End With
        Next wkst
        
        Application.PrintCommunication = True
        
        wb.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    End Sub