try
Sub test()
Dim wbBonus As Workbook, wbDest As Workbook
Dim a(), i As Long, r As Range, x
Workbooks.Open Filename:="c:\bonus.xls"
Workbooks.Open Filename:="c:\Destination.xls"
Set wbBonus = Workbooks("bonus.xls")
Set wbDest = Workbooks("Destination.xls")
With wbBonus.Sheets("Ark1")
x = Application.CountIf(.Range("a:a"), "a") + _
Application.CountIf(.Range("a:a"), "c")+ _
Application.CountIf(.Range("c:c"),"c")
ReDim a(1 To x, 1 To 3)
For Each r In .Range("a1", .Range("a65536").End(xlUp))
If r.Value = "a" Or r.Value = "c" or _
r.Offset(,2).value="c" Then
i = i + 1: a(i, 1) = r.Offset(, 5)
a(i, 2) = r.Offset(, 11): a(i, 3) = r.Offset(, 6)
End If
Next
End With
With wbDest.Sheets("Ark1")
..Cells.Clear
..Range("a2").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Erase a
End Sub