Combreal icon

AddRow.vba

Combreal | PRO | 05/21/21 11:01:28 AM UTC (Edited) | 0 ⭐ | 1665 👁️ | Never ⏰ | []
VBScript |

1.43 KB

|

None

|

0 👍

/

0 👎

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

  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎