Still just inserted a blank row...

"Barb Reinhardt" wrote:

Try this:

Sub InsertRowCopyDownwDelete()
Dim aWS As Worksheet
Dim ClearRange As Range
Dim Area As Range
Dim RowNumber As Variant

Set aWS = ActiveSheet

aWS.Unprotect

ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).EntireRow.Hidden = False

'Application.CutCopyMode = False


Set ClearRange = Range("I:I,L:L,N:P,T:DK")
RowNumber = ActiveCell.Row
If RowNumber 1 Then
For Each Area In ClearRange.Areas
Area.Rows(RowNumber).ClearContents
Next Area
End If
ActiveCell.Activate

Set ClearRange = Nothing
Set Area = Nothing

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True,
AllowFiltering _
:=True


End Sub


"lilbit3684" wrote:

I have a macro that copies the active cell's row and pastes it in the row
below it. It then deletes certain columns of data from the new row that was
pasted. However, I've noticed that it does not work when I the data is
filtered. It only inserts a blank row. Is there any way to get this to work
with the data filtered?

Sub InsertRowCopyDownwDelete()

ActiveSheet.Unprotect

ActiveCell.EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

Dim ClearRange As Range
Dim Area As Range
Dim RowNumber As Variant

Set ClearRange = Range("I:I,L:L,N:P,T:DK")
RowNumber = ActiveCell.Row
If RowNumber 1 Then
For Each Area In ClearRange.Areas
Area.Rows(RowNumber).ClearContents
Next Area
End If
ActiveCell.Activate

Set ClearRange = Nothing
Set Area = Nothing

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True,
AllowFiltering _
:=True


End Sub