--- x8 centers If Cells(Target.Row, 5).Value <= Cells(Target.Row, 6).Value And Not IgnoreAlert Then 'And Len(Target) <= 4 --------stock Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.OnKey "%{UP}", "addRow" End Sub ------- module 2 Public IgnoreAlert As Boolean Sub addRow() Dim stock Set stock = Sheets("Stock") Dim tTotalRows As Long Dim RowPos As Integer Dim ws As Worksheet IgnoreAlert = True tTotalRows = stock.Cells.SpecialCells(xlLastCell).Row + 1 tTotalRows = stock.Range("A" & tTotalRows).End(xlUp).Row RowPos = ActiveCell.Row ActiveCell.EntireRow.Copy Range(ActiveCell, ActiveCell).EntireRow.Insert Shift:=xlDown Application.CutCopyMode = False Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Worksheets If Not ws.Name = "Stock" Then ws.Activate Cells(RowPos, 1).EntireRow.Copy Cells(RowPos, 1).EntireRow.Insert Shift:=xlDown Application.CutCopyMode = False End If Next ws Application.ScreenUpdating = True Worksheets("Stock").Activate Range(Cells(2, 5), Cells(4, 5)).AutoFill Destination:=Range(Cells(2, 5), Cells(tTotalRows, 5)), Type:=xlFillDefault Range(Cells(2, 8), Cells(4, 8)).AutoFill Destination:=Range(Cells(2, 8), Cells(tTotalRows, 8)), Type:=xlFillDefault IgnoreAlert = False End Sub