Bonjour jojorih628, fcyspm30, le forum,
Une variante...
Sub copie()
'déclarations des variables
Dim tb, newtb(), i%, j%, k%
Dim a, b
'colonnes de destination
a = Array(1, 2, 3, 4, 10, 11, 12)
'colonnes source
b = Array(1, 2, 3, 4, 6, 7, 8)
'agit sur cette feuille
With Sheets("Feuil1")
'définit le tableau de données temporaire tb
tb = .ListObjects("Tableau2").DataBodyRange
'définit la première cellule vide du Tableau1
With .ListObjects("Tableau1")
'si le tableau comporte des données
If .InsertRowRange Is Nothing Then
'1ère cellule vide (colonne 1 du tableau,nombre de lignes du tableau+1)
Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
'sinon
Else
'1ère cellule colonne 1 du tableau
Set rcell = .InsertRowRange.Cells(1)
End If
End With
'indice de départ de newtb
k = 0
'redimensionne le tableau temporaire newtb
ReDim newtb(0 To UBound(tb, 1), 1 To 12)
'boucle sur les lignes du tableau de données tb
For i = 1 To UBound(tb, 1)
'correspondance des colonnes
For x = LBound(a, 1) To UBound(a, 1)
newtb(k, a(x)) = tb(i, b(x))
Next x
'incrémente l'indice
k = k + 1
'prochaine ligne
Next i
'si une erreur survient, on l'ignore
On Error Resume Next
'retranscription du tableau newtb dans Tableau1
rcell.Resize(k, 12).Value = newtb
End With
'Libère la mémoire
Erase tb: Erase newtb: Erase a: Erase b: Set rcell = Nothing
End Sub
Cordialement,