danuk76
11-20-2015, 06:47 PM
hi guys
I have this macro that works great to copy the entire row down if a cell in I is 20
What I want it to do is Copy the entire row down if a cell in I is GREATER than 20
Lots of searching and head scratching to no avail :think:
Sub abc()
Dim Lrow As Long, i As Long
Dim aRng As Range
Lrow = Cells(Rows.Count, "I").End(xlUp).Row
Set aRng = Range("I1:I" & Lrow)
aRng.Select
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If InStr(Selection.Rows(i), "20") > 0 Then
Selection.Rows(i).EntireRow.Copy
Selection.Rows(i).EntireRow.Insert Shift:=xlShiftDown
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
end sub
I have this macro that works great to copy the entire row down if a cell in I is 20
What I want it to do is Copy the entire row down if a cell in I is GREATER than 20
Lots of searching and head scratching to no avail :think:
Sub abc()
Dim Lrow As Long, i As Long
Dim aRng As Range
Lrow = Cells(Rows.Count, "I").End(xlUp).Row
Set aRng = Range("I1:I" & Lrow)
aRng.Select
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If InStr(Selection.Rows(i), "20") > 0 Then
Selection.Rows(i).EntireRow.Copy
Selection.Rows(i).EntireRow.Insert Shift:=xlShiftDown
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
end sub