Copy Paste by vba

This can be changed to copy/paste but that is less efficient. Main2() returns a jagged fill as requested in discussion.

In a Module, change value of p to your path. 

Sub Main2()
    Dim ws1 As Worksheet, r1 As Range, f1 As Range
    Dim ws2 As Worksheet, r2 As Range, f2 As Range
    Dim p As String, r As Range

    p = ThisWorkbook.Path & "\" 'Path for workbooks to open.
    'ws1 and ws2 workbooks are expected to exist and worksheet index of 1 for each
    Set ws1 = Workbooks.Open(p & "ap.xls").Worksheets(1)
    Set ws2 = Workbooks.Open(p & "PL2.xlsx").Worksheets(1)

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Set r1 = ws1.Range("E2", ws1.Cells(ws1.Rows.Count, "E").End(xlUp))
    Set r2 = ws2.Range("A2", ws2.Cells(ws2.Rows.Count, "A").End(xlUp))

    For Each f2 In r2
        Set f1 = r1.Find(f2)
        If Not f1 Is Nothing Then
            Set r = ws2.Cells(f2.Row, ws2.Columns.Count).End(xlToLeft).Offset(, 1)
            If r.Column < 3 Then Set r = ws2.Cells(f2.Row, "C")
            r = ws1.Cells(f1.Row, "R")
        End If
    Next f2

    ws2.Parent.Close True
    ws1.Parent.Close False
    Application.ScreenUpdating = True
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    MsgBox "Tasks are done."
End Sub

'similar to, https://www.teachexcel.com/talk/3770/vba-code-to-vlookup-and-display-missing-values-in-new-workbook
Sub Main()
    Dim ws1 As Worksheet, r1 As Range, f1 As Range
    Dim ws2 As Worksheet, r2 As Range, f2 As Range
    Dim a, i As Long, p As String

    p = ThisWorkbook.Path & "\" 'Path for workbooks to open.
    'ws1 and ws2 workbooks are expected to exist and worksheet index of 1 for each
    Set ws1 = Workbooks.Open(p & "ap.xls").Worksheets(1)
    Set ws2 = Workbooks.Open(p & "PL.xlsx").Worksheets(1)
    
    Application.ScreenUpdating = False

    Set r1 = ws1.Range("E2", ws1.Cells(ws1.Rows.Count, "E").End(xlUp))
    Set r2 = ws2.Range("A2", ws2.Cells(ws2.Rows.Count, "A").End(xlUp))
    
    ReDim a(1 To r2.Count)
    For Each f2 In r2
        i = i + 1
        a(i) = ""
        Set f1 = r1.Find(f2)
        If Not f1 Is Nothing Then a(i) = ws1.Cells(f1.Row, "R")
    Next f2

    If a(1) = "" And UBound(a) = 1 Then GoTo EndSub
    
    i = ws2.UsedRange.Columns.Count + 1
    ws2.Cells(2, i).Resize(UBound(a)).Value = WorksheetFunction.Transpose(a)
    
EndSub:
    ws2.Parent.Close True
    ws1.Parent.Close False
    Application.ScreenUpdating = True
    MsgBox "Tasks are done."
End Sub

Hi There 

I have had quick look at your files. 

Can you confirm that ap.xls = target1.xls

Also there are only 2 items in target 1 that meet your criteria. That is  

MARICO M&MFIN

on rows 4 and 5.

and that the value from column R is to be written the next empty cell after column B

What have you tried so far and what is giving you the problem?

K1

Try the attached.

Just press the do it button

Yes Sir ap.xls= target1.xls

TCS MARICO AND M&MFIN meet our criteria

correct next empty cell after column B (if column C is blank then start pasting data from there if there is data in column C then paste the data in column D and if column D also has data then from E and so on......)

Sir i tried the code but i was unsuccessful my code is useless sir so plz have a look Sir