VB Code to copy and paste at certain location

Hello:

I have data in Column F:H and Column J:L

I need a VB Code to perform the following:

First check 6 occurrence of text string "REPORT END" in column F.
Once it finds the last 6th "REPORT END"in column F, leave one blank row and then copy the content from column J:L.

Let me know if you have any questions.

Thanks

Riz

Hello Riz,

Can you provide a before and after example?

Hello Riz,

Will it always be the 6th occurrance of "Report End" or can the macro work from the " bottom up" from the bottom the worksheet and find "Report End"?

hi Leith:

Yes it wil always be after the 6th occurance.

Or best if we can find the end of data in Column F.

thanks

Riz

Hello Riz,

I have added the macro below to the attached workbook. Let me know if this works for you.

Sub CopyAndInsert()

    Dim EndRow  As Long
    Dim FoundIt As Range
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        EndRow = Wks.Cells(Rows.Count, "F").End(xlUp).Row
        
        Set Rng = Wks.Range("F1:F" & EndRow)
        
        Set FoundIt = Rng.Find("Report End", , xlFormulas, xlWhole, xlByRows, xlPrevious, False, False, False)
        
            If Not FoundIt Is Nothing Then
                Wks.Range("J2").CurrentRegion.Copy Destination:=FoundIt.Offset(2, 0).CurrentRegion
            End If
        
End Sub

Hello Riz,

The change to the macro is in blue.

Sub CopyAndInsert()

    Dim EndRow  As Long
    Dim FoundIt As Range
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        EndRow = Wks.Cells(Rows.Count, "F").End(xlUp).Row
        
        Set Rng = Wks.Range("F1:F" & EndRow)
        
        Set FoundIt = Rng.Find("Report End", , xlFormulas, xlWhole, xlByRows, xlPrevious, False, False, False)
        
            If Not FoundIt Is Nothing Then
                Wks.Range("J2").CurrentRegion.Copy Destination:=Range("F600")
            End If
        
End Sub

Hello Riz,

The change to the macro is in blue.

Sub CopyAndInsert()

    Dim EndRow  As Long
    Dim FoundIt As Range
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        EndRow = Wks.Cells(Rows.Count, "F").End(xlUp).Row
        
        Set Rng = Wks.Range("F1:F" & EndRow)
        
        Set FoundIt = Rng.Find("Report End", , xlFormulas, xlWhole, xlByRows, xlPrevious, False, False, False)
        
            If Not FoundIt Is Nothing Then
                Wks.Range("J2").CurrentRegion.Copy Destination:=Range("F600")
            End If
        
End Sub