cell shift

' Code of Module1
Dim RngUndo(1 To 2) As Range

Sub SynchroInsert()
  ' Insert with shifting
  With Selection
    Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count).Insert Shift:=xlToRight
    .Insert Shift:=xlToRight
  End With
  ' Save inserted ranges for undo
  With Selection
    Set RngUndo(1) = .Cells
    Set RngUndo(2) = Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count)
  End With
  ' Charge undo buffer
  Application.OnUndo "Undo synchro-ins.", "InsertingUndo"
End Sub

' Undo subruotine
Sub InsertingUndo()
  On Error Resume Next
  RngUndo(1).Delete Shift:=xlShiftToLeft
  RngUndo(2).Delete Shift:=xlShiftToLeft
End Sub

' Code of Module1
Const UndoSteps = 10      ' <-- undo buffer max steps for syncro inserted ranges
Dim UndoCol As New Collection

' Code of "Synchro inserting" button
Sub SynchroInsertButton()
  Dim Rng(1 To 2) As Range
  ' Insert with shifting
  With Selection
    Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count).Insert Shift:=xlToRight
    .Insert Shift:=xlToRight
  End With
  ' Save references of inserted ranges in Rng()
  With Selection
    Set Rng(1) = .Cells
    Set Rng(2) = Sheets("AFT").Range(.Address).EntireRow.Columns("F").Resize(, .Columns.Count)
  End With
  ' Save Rng in collection
  UndoCol.Add Rng
  ' Delete an extra steps of undo buffer
  If UndoCol.Count > UndoSteps Then
    UndoCol.Remove 1
  End If
End Sub

' Code of "Undo of synchro inserting" button
Sub UndoButton()
  Dim a
  If UndoCol.Count = 0 Then
    MsgBox "Undo buffer of synchro inserted cells is empty"
    Exit Sub
  End If
  On Error Resume Next
  a = UndoCol.Item(UndoCol.Count)
  a(1).Parent.Select
  a(1).Select
  a(1).Delete Shift:=xlShiftToLeft
  a(2).Delete Shift:=xlShiftToLeft
  UndoCol.Remove UndoCol.Count
End Sub