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