Automatically number rows

[verlander1]

Hi, I need help.

I have a macro that automatically cuts a row from one sheet and pastes it at the bottom of another archived sheet based on a value in column J . This works fine, its just theres a numbered row column in column A, and when it cuts and pastes, it will paste row 3 in like row 13 and etc. out of order.

So bottom line, I need help on a macro that automatically numbers each row on the two sheets starting at 1 from A5 down to like 65 at A69 (or automatically to the last filled row if possible, but this is not neccassary.)

I have a macro on sheet 1 working, so if someone could come up with a macro for sheet 2 (or both if easier for you) that would be a big help. If I didn't explain it well enough let me know. Thanks!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer, x As Integer
Dim Cws As Worksheet
Dim Aws As Worksheet
On Error GoTo myExit
Set Aws = ThisWorkbook.Sheets("Archived Continuous Improvement")
Set Cws = ThisWorkbook.Sheets("Continuous Improvement Form")
lr = Cws.Cells(Rows.Count, "J").End(xlUp).Row
Application.EnableEvents = False
For x = lr To 2 Step -1
    If Cells(x, "J").Value = 100 Then
        Cws.Rows(x).EntireRow.Copy Aws.Range("A" & Aws.Cells(Rows.Count, "J").End(xlUp).Row).Offset(1)
        Cws.Rows(x).Delete Shift:=xlUp
        Rows("33:33").Select
    Selection.Insert Shift:=xlDown
    Range("C33").Select
        Range("J34").Select
    Selection.Copy
    Range("J33").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False


    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=R[-4]C+1"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("A6").Select
    Selection.AutoFill Destination:=Range("A6:A34"), Type:=xlFillDefault
    Range("A6:A31").Select
    ActiveWindow.SmallScroll Down:=-18
        ActiveCell.FormulaR1C1 = "=R[-4]C+1"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("A6").Select
    Selection.AutoFill Destination:=Range("A6:A68"), Type:=xlFillDefault
    Range("A6:A68").Select
    ActiveWindow.SmallScroll Down:=-63
 
    End If
Next x
myExit:
Application.EnableEvents = True

End Sub

 

[C Moore]

Can I suggest a different approach? Record a macro while using the autofilter. Turn on Filter, in column j use value =100, then copy visible cells where you want them. It will run faster than stepping through it.