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
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
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.