Excel - Same headers across multiple Sheets

You can always add references to the other sheets, i.e. put  =Sheet1!A1   into A1 and drag to the right.
However, if you change the sequence of columns, and that includes deleting, header and values do not fit together anymore, so the request is questionable.

sktneer comment only applies if you change a value in a header as it does the copy for you.

I cant see how deleting or inserting a column is detected, so cant apply any update.

If this is during the setup process you can select multiple sheets by holding shift as you click on the tab names, all the changes you make on one sheet will be reflected in the others, however it will only work when all sheets are selected in a group so its not so useful when handing this out to end-users because they forget and things get out of step

Hi knowlton,

I'm not sure this is what you are after, but if you have changes that you want to happen to more than 1 sheet, you can:

1. Select all the sheet names you want changes to occur in (e.g. hold down Ctrl, click each of the sheet tabs down the bottom, then release Ctrl.  You can also use Shift to select ranges.  Similar to selecting files with Windows Explorer).  You should now see all sheet names are highlighted.
2. Make the required changes to the currently visible sheet (it shouldn't matter which sheet that is).
3. When you want to stop doing multi-sheet updates, click an unselected sheet name (if there is one), or any sheet if all are selected.  You should now see only 1 sheet name is highlighted.

This should work for your headings and column insertions.  Works for me in Excel 2007.

maybe it can work, but assuems all your worksheets are the same configuration...

put this in the ThisWorkbook macro module.

Public OldColCount As Long
Const header = "1:1"
Private Sub Workbook_Open()
    OldColCount = ActiveSheet.UsedRange.Columns.Count
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    
    If Intersect(Sh.Range(header), Target) Is Nothing Then
        'no change to header
        Exit Sub
    End If
    Debug.Print "Sheet chnaged:" & Sh.Name & "== range:" & Target.Address

    
    Application.EnableEvents = False  'turn of future events in the process
    
    Dim NewColCount As Long
    NewColCount = ActiveSheet.UsedRange.Columns.Count
    
    If NewColCount > OldColCount Then
        'column inserted.  Target is the blank column
        'insert this column to all worksheets
        colid = Target.Column
        For Each ws In ActiveWorkbook.Sheets
            If ws.Name = ActiveSheet.Name Then
                'do nothing
             Else
                ws.Columns(colid).Insert
            End If
        Next ws
        'reset col count
        OldColCount = NewColCount
     ElseIf NewColCount < OldColCount Then
        'column deleted.  target is column to the right of deleted column
        colid = Target.Column
        For Each ws In ActiveWorkbook.Sheets
            If ws.Name = ActiveSheet.Name Then
                'do nothing
             Else
                ws.Columns(colid).Delete
            End If
        Next ws
        OldColCount = NewColCount
     Else
        'was a simple header change
        'copy Target cell to same on all sheets
        For Each ws In ActiveWorkbook.Sheets
            If ws.Name = ActiveSheet.Name Then
                'do nothing
             Else
                Target.Copy Destination:=ws.Range(Target.Address)
            End If
        Next ws
    End If

    Application.EnableEvents = True
End Sub

Select allOpen in new window

note that it uses the ActiveSheet.UsedRange property that is unreliable.
header-update.xls

But I now see that regmigrant has already given a summary of what I was trying to say.  I must learn to type faster!

Tel did mention using CTRL so you can select sheets that aren't next to each other; faster typing not always best :)

I think I  missed the removing a column criteria, so tweaked the code and hope it will work as per your requirement now...

Place the following code into ThisWorkbook Module by following the instructions mentioned in my last post.

Option Explicit
Dim oH As String
Dim Actlc As Long
Dim col As Long

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ws As Worksheet
Dim lc As Long, i As Long
Dim hRnd As Range, Cell As Range
Application.EnableEvents = False
Actlc = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

For Each ws In Worksheets
    If ws.Name <> ActiveSheet.Name Then
        For i = 1 To Actlc
            ws.Cells(1, i) = Cells(1, i)
        Next i
        lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        If Actlc <> lc And oH <> "" Then
            If Cells(1, col) <> oH Then
                ws.Columns(col).Delete
            End If
        End If
    End If
Next ws
Application.EnableEvents = True
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Actlc = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
If Selection.Column <= Actlc Then
    Application.EnableEvents = False
    oH = Cells(1, Selection.Column)
    col = Selection.Column
    Application.EnableEvents = True
End If
End Sub

Select allOpen in new window