Kopirer fra et regneark til et andet

Jeg har en makro som kopirer celler fra regneark bonus til regneark destination. Der kopires kun celler fra kolonnerne b,n og o og indsættes i regneark bonus ark1 med start i celle a2. Cellerne kopires under betingælse af at kolonne a er lige med "a" og samtidig er kolonne c lige med "c" eller at både kolonne a og c er lige med "c".

Jeg vil gerne udvide makro sådan at:
Hvis kolonne a er lige med "a" og  kolonne c samtidig er lige med "d" så indsættes celler i regneark bonus ark2.
Hvis kolonne a er lige med "a" og samtidig kolonne c er lige med "k" så indsættes celler i regneark bonus ark10.
osv.




Private Sub CommandButton2_Click()

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" And _
            r.Offset(, 2).Value = "c" Or _
            r.Value = "c" And r.Offset(, 2).Value = "c" Then
            i = i + 1: a(i, 1) = r.Offset(, 1)
            a(i, 2) = r.Offset(, 13): a(i, 3) = r.Offset(, 14)
            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