Adjust macro to insert copied cells always at the top of a sheet.

[Matt_Straya]

Hi,
I have created a macro that finds rows that have the word "Completed" in it and then copies those rows and inserts them into another sheet called "Completed",
What I'd like it to do is always insert the copied cells at the top of the sheet "Completed". Any advice is warmly welcomed!

Sub CopyRows()
  Dim bottomL As Integer
  Dim x As Integer
  bottomL = Sheets("2016").Range("O" & Rows.Count).End(xlUp).Row: x = 1
 
  Dim c As Range
  For Each c In Sheets("2016").Range("O6:O" & bottomL)
  If c.Value = "Completed" Then
  c.EntireRow.Copy Worksheets("Completed").Range("A" & x)
  x = x + 1
  End If
  Next c
 
End Sub

 

[Asheesh]

Welcome to the forum

I see that you are looping through all the cells in column “O” to find the word complete..then copy it and paste it below on the “completed” tab..If you continue to follow this process and instead of looking for the last row(bottomL), you can insert a row just below the header and paste the copied values…

Something on the below lines…

Assuming Row no 5 is a header

  Rows(6).Insert
  Range("A6").PasteSpecial Paste:=xlPasteValues

There are more ways of doing it..This is just one..

 

[Matt_Straya]

Thanks Asheesh! Would that go at the end of the code? I am just new at all this. I have attached the file to maybe provide a better idea.

 

[Nebu]

Hi: May be some thing like this.

Sub test()
Application.ScreenUpdating = False

Const str As String = "Completed"
Dim rng As Range, fnd As Range

Set rng = Sheet2.Range("O6:O" & Sheet2.Cells(Rows.Count, "O").End(xlUp).Row)
Set fnd = rng.Find(What:=str, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
   
If Not fnd Is Nothing Then
    addr$ = fnd.Address
    Sheet2.Rows(fnd.Row).Copy
    Sheet3.Cells(3, 1).EntireRow.Insert
    Sheet3.Cells(3, 1).PasteSpecial

    Do
        Set fnd = rng.FindNext(After:=fnd)
        If Not fnd Is Nothing Then
            If addr = fnd.Address Then Exit Do
                Sheet2.Rows(fnd.Row).Copy
                Sheet3.Cells(3, 1).EntireRow.Insert
                Sheet3.Cells(3, 1).PasteSpecial
        Else
            Exit Do
        End If
    Loop
Else
    Exit Sub
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Thanks

 

[Matt_Straya]

Thanks Nebu - it does exactly as asked but there is a few formatting issues. I will play with it and see it I can sort it. Thanks a lot this has helped immensely!