Bonjour
j'ai créé ce code pour copier des valeurs filtrées d'une autre feuille et insère des formules dans certaines colonnes.
Feuille source = Histo
Feuille destination = FILT
ma question est de savoir si je ne pourrais pas mettre des boucles pour simplifier ce code ?

Merci pour un conseil
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Sub ExtractFILT()
'
' ExtractFILT Macro
'
 
'Cette macro copie dans la feuille "FILT" les valeurs filtrées de la feuilles "HISTO"
    Dim i As Long, j As Long
    Dim dercell As Integer
 
    Application.ScreenUpdating = False
    Sheets("FILT").Select
    Cells.Clear 'efface les valeurs de la feuille
    'Affecte les noms d'en-têtes
    Range("A1") = "TITRE"
    Range("B1") = "NOM"
    Range("C1") = "PRENOM"
    Range("D1") = "SECTEUR"
    Range("E1") = "DATE DERNIER SERVICE"
    Range("F1") = "NOM SERVICE"
    Range("G1") = "RANG"
    Range("H1") = "ECART"
    Range("I1") = "DATE ARRIVÉE"
    Range("J1") = "DATE SEM"
 
    Sheets("HISTO").Select
 
    ActiveSheet.Range("$A$1:$N$621").AutoFilter Field:=6, Criteria1:="=FILTRAGE", _
        Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$N$621").AutoFilter Field:=1, Criteria1:=Array( _
        "ING", "ACT", "SER", "PLO"), Operator:=xlFilterValues
    Range("A2:F5000").Select
    Selection.Copy
    Sheets("FILT").Select
 
 
   'insere formules
    Range("A2").Select
    ActiveSheet.Paste
    dercell = Range("a65000").End(xlUp).Row
    Range("G2" & ":" & "G" & dercell).FormulaR1C1 = "=RANK.EQ(RC[1],C[1])"
    Range("H2" & ":" & "H" & dercell) = "=IF(RC[-3]="""",TODAY()-RC[1],TODAY()-RC[-3])"
    Range("H2:H5000").NumberFormat = "0"
    Range("I2" & ":" & "I" & dercell).FormulaR1C1 = "=IF(VLOOKUP(RC[-7],Listenom,5,0)="""","""",VLOOKUP(RC[-7],Listenom,5,0))" 'Plage ListeNom
    Range("J2" & ":" & "J" & dercell).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-8],tSgt,4,0),"""")" 'plage tSGT
    Range("I2" & ":" & "J" & dercell).NumberFormat = "m/d/yyyy"
    Range("A1").Select
    Application.CutCopyMode = False
 
'recherche et supprime la date la plus ancienne de la feuille
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
For j = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(j, 2) = Cells(i, 2) Then
If Cells(j, 5) < Cells(i, 5) Then
Cells(j, 1).EntireRow.Delete
End If: End If
Next j: Next i
'tri croissant sur la colonne G
    ActiveSheet.Sort.SortFields.Add Key:=Range("G:G") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A:J")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
    Sheets("HISTO").Select
    ActiveSheet.ShowAllData
End Sub