--- 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
Comments
0 B
|👍
/👎