Sub test()
Dim F As Worksheet
Set F = ThisWorkbook.Worksheets("Feuil1")
Dim F2 As Worksheet
Set F2 = ThisWorkbook.Worksheets("Feuil2")
' Valeur chercher F4 (Cellule)
Dim val As String
val = LCase(F.Cells(4, 6))
' Redimension du tableau
Dim tabVal()
tabVal = F.Range(F.Cells(10, 1), F.Cells(65536, 19).End(xlUp))
ReDim Preserve tabVal(1 To F.Cells(65536, 1).End(xlUp).Row - 9, 1 To 20)
' Suppression des données
F.Range(F.Cells(10, 1), F.Cells(65536, 19).End(xlUp)).Clear
' Partage du même tableau en mémoire avant modification
Dim tabValOrg()
tabValOrg = tabVal
' Traitement des données (Filtre sur la colonne 2 du tableau avec critére
' en Cellule F4
For i = 1 To UBound(tabVal, 1)
If tabVal(i, 2) = val Then
tabVal(i, 20) = val
End If
Next i
' Compteur Pour Nouvelle dimenssion
Dim cpt As Double
cpt = 0
' Restitution des donnée
For i = 1 To UBound(tabVal, 1)
If tabVal(i, 20) = val Then
cpt = cpt + 1
For j = 1 To 19
tabVal(cpt, j) = tabVal(i, j)
Next j
End If
Next i
' Modification d'une instruction :
' Explication :
' Je colle ici avec ce code = UBound(tabVal, 2)
' 20 colonnes
' et je doit en faite coller que 19 colonnes
' soit avec la modif ici = UBound(tabVal, 2)-1
' Extraire le tableau
' de la premiere ligne du tableau a une ligne donnée
' exemple tableau de 1 a 500 ligne et cpt = la 230 éme ligne
' soit ligne 1 a 230 sur toute les colonnes du tableau
'F.Cells(10, 1).Resize(cpt, UBound(tabVal, 2)).Value = tabVal
F.Cells(10, 1).Resize(cpt, UBound(tabVal, 2) - 1).Value = tabVal
' Le tableau d'origine est sauvegarder "tabValOrg"
' il est recopier en entier sur sur la feuille 2:
F2.Cells(10, 1).Resize(UBound(tabValOrg, 1), UBound(tabValOrg, 2)).Value = tabValOrg
Erase tabVal, tabValOrg
End Sub