Importer certains données d'une feuille à une autre

Sub Importer()
Dim crit1$, col1%, crit2$, col2%, a, ub%, tablo, resu(), i&, n&, j%, v As Variant
crit1 = "TER05": col1 = 1 'à adapter
crit2 = "2566": col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, 14)
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If UCase(tablo(i, col1)) = crit1 And CStr(tablo(i, col2)) = crit2 Then '2 critères vérifiés
        For j = 0 To ub
            v = tablo(i, a(j))
            If IsNumeric(v) Then resu(n, j) = CDbl(v) Else resu(n, j) = v
        Next j
        n = n + 1
    End If
Next i
If n = 0 Then Exit Sub
'---restitution---
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With
End Sub

Sub Importer()
Dim ad1$, ad2$, a, ncol%, dest As Range, i%
Application.ScreenUpdating = False
ThisWorkbook.Names.Add "Crit1", "TER05": ThisWorkbook.Names.Add "Crit2", "=""2566""" 'noms définis à adapter
ad1 = "A2": ad2 = "J2" 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set dest = .Cells(.Rows.Count, 4).End(xlUp)(2)
End With
With Sheets("BD").[A1].CurrentRegion
    ncol = .Columns.Count
    .Cells(2, ncol + 2) = "=AND(Crit1=" & ad1 & ",Crit2=" & """""&" & ad2 & ")" 'zone de critères
    .AdvancedFilter xlFilterInPlace, .Cells(1, ncol + 2).Resize(2)
    For i = 0 To UBound(a)
        .Columns(a(i)).Copy dest.Offset(, i)
    Next
    dest.Resize(, UBound(a) + 1).Delete xlUp 'supprime les titres
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    .Cells(2, ncol + 2) = ""
End With
End Sub

Sub Importer()
Dim crit1$, crit2$, col1%, col2%, a, ub%, tablo, resu(), i&, n&, j%, v As Variant
With Sheets("Utilisateurs").[A1].CurrentRegion
    crit1 = CStr(.Cells(.Rows.Count, 1))
    crit2 = CStr(.Cells(.Rows.Count, 2))
End With
col1 = 1: col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, 14)
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If UCase(tablo(i, col1)) = crit1 And CStr(tablo(i, col2)) = crit2 Then '2 critères vérifiés
        For j = 0 To ub
            v = tablo(i, a(j))
            If IsNumeric(v) Then resu(n, j) = CDbl(v) Else resu(n, j) = v
        Next j
        n = n + 1
    End If
Next i
'---restitution---
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With
'---RAZ---
With Sheets("BD")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .[A1].CurrentRegion.Offset(1).Delete xlUp
End With
End Sub