Adding new rows

[sk8rider]

Hello,

Any help with this solution would be greatly appreciated.

I have two sheets (sheet1 and sheet2). In sheet1 one I do som
filtering. Sheet2 looks like this:

Priority1


Priority2
Priority3



Priority4

I would like to move the results(rows) from the filtered sheet1 an
insert between Priority2 and Priority3, and push down the labe
Priority3.

Thanks in advace

 

[Tom Ogilvy]

Sub Tester1()
Dim rng As Range, rng1 As Range
Dim rng2 As Range
With Worksheets("Sheet1")
Set rng = .AutoFilter.Range
End With
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
numRow = rng.Columns(1).SpecialCells(xlVisible).Count
rng.Copy
With Worksheets("Sheet2")
Set rng1 = .Columns(1).Find("Priority3")
End With
If Not rng1 Is Nothing Then
Set rng2 = rng1.Offset(-1, 0)
rng1.EntireRow.Resize(numRow).Insert
rng.Copy
Worksheets("Sheet2").Paste rng2.Offset(1, 0)
End If

End Sub

 

[sk8rider]

Thanks a lot Tom your post helped me resolved my issue.

Take care