Automatically number rows

verlander1

New Member
Joined
Jun 4, 2015
Messages
10
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!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Welcome to the Board!

If you use =ROW()-1 for your row numbering it will renumber automatically.

It'll help if you post your code.

HTH,
 
Upvote 0
Welcome to the Board!

If you use =ROW()-1 for your row numbering it will renumber automatically.

It'll help if you post your code.

HTH,

yeah sure no problem

Code:
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
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,206,753
Messages
6,074,745
Members
446,082
Latest member
fgiron83

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top