VBA pour remplacer VLOOKUP

Version imprimable

Bonjour à tous,

Je vous pose le contexte :
* 1 fois par semaine, une collègue fait un extraction BO pour un avoir la "descente de portefeuille" (*) au format xls.
* Pour les chantiers déjà existant, elle fait une recherchev qui pointe sur la "descente de portefeuille" de la semaine passée afin de récupérer des calculs déjà faits.
* Pour les nouveaux chantiers, elle fait ses calculs.
* Q. Comment applique-t-elle sa recherchev ?
R. Elle copie sa formule sur la 1ère cellule concernée d'une colonne puis l'applique sur les cellules qui suivent dans la même colonne.

C'est chronophage et elle doit faire cela sur plusieurs colonnes.
Difficulté supplémentaire = le nombre de ligne de ce tableau n'est pas fixe ; cela varie selon les semaines.

(*) descente de portefeuille = suivi des avancées chantiers basé sur un numéro de dossier

J'aimerais lui faire gagner du temps de traitement et j'ai pensé à un script vba sauf que je suis une bille (ou une bite, c'est comme tu veux) (**)
L'objectif de ce script est de :
* aller chercher une valeur dans un autre fichier excel (colonne 32), là ou le numéro de chantier est le même (colonne 1) et l'appliquer sur la colonne 32 du nouveau fichier
* appliquer cette recherche / application tant qu'un numéro de chantier existe en colonne 1 du nouveau fichier
* une fois que toutes les valeurs sont appliquées, vider les cellules en erreur ou dont la valeur = 0

Si vous pouviez m'apporter la solution sur un plateau d'argent, ce serait géantissime.
A défaut, si vous pouviez m'aiguiller, je serai très heureux aussi ;)

Modification :
J'ai oublié de préciser que j'ai fait un enregistrement macro comme suit :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub LYCOS() ' ' LYCOS Macro ' RechercheV ' correspondance entre numero de dossier colonne A de la descente de portefeuille semaine passee et semaine en cours ' insertion des valeurs dans les colonnes AF AG et AG ' application jusqu'aux cellules ligne 400 ' ' ActiveCell.FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-31],'D:\TESTDDP\Ancien\[DDPOLD.xls]descente de P'!R10C1:R400C37,32,FALSE),"""")" Range("AG10").Select ActiveCell.FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-32],'D:\TESTDDP\Ancien\[DDPOLD.xls]descente de P'!R10C1:R400C37,33,FALSE),"""")" Range("AH10").Select ActiveCell.FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-33],'D:\TESTDDP\Ancien\[DDPOLD.xls]descente de P'!R10C1:R400C37,34,FALSE),"""")" Range("AF10:AH10").Select Selection.AutoFill Destination:=Range("AF10:AH400"), Type:=xlFillDefault End Sub
Cet enregistrement ne me satisfait pas dans le sens où il ne prend pas en compte les différences de nombres de lignes selon les fichiers ; il s'applique jusqu'à la ligne 400, que les lignes soient alimentées ou non.

En plus, le fichier peut évoluer (ajout/suppr de colonnes) et je ne sais pas comment faire pour que la recherche se fasse par rapport à un nom de colonne au lieu des numérotations
Par ex, le 1er IfError concerne la colonne 32 (AF, nommée ETUDE), le 2nd est pour la colonne 33 (AG, nommée EXE) et le dernier pour la colonne 34 (AH, nommée MARCHE)

16/09/2021, 11h53
EricDgn

Bonjour,

Ne pourriez-vous pas mettre un petit fichier exemple avec quelques lignes données (3 suffiraient) ? Cela aiderait à bien comprendre le problème.

Cordialement.
16/09/2021, 17h37
olivier_alliance

2 pièce(s) jointe(s)

Bonjour EricDgn

Voici les 2 fichiers avec les colonnes sur lesquelles automatiser la recherchev :

Pièce jointe 604865 = descente de portefeuille semaine S
Pièce jointe 604866 = descente de portefeuille semaine S-1

Le contenu des colonnes AF, AG et AH du fichier semaine S-1 doit être réinjecté dans les colonnes AF, AG et AH du fichier semaine S.
Le point de liaison est le numéro de dossier (colonne A de chaque fichier)
L'ordre d'affichage des numéros de dossier change (nouveau dossier, dossier clôt, etc.).

Bonjour,

Une façon de faire pour inscrire les formules dans les 3 colonnes titrées "Etude", "Exe" et "Marches" en considérant que dans les 2 fichiers ces titres sont en ligne 1 et les données récupérées dans la première feuille du fichier mais il n'est pas obligé que les colonnes soient aux mêmes endroits.

Code:

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
Option Explicit
 
Sub Reprendre()
    Dim fd As Office.FileDialog, sFile As String
    Dim wbData As Workbook, wshData As Worksheet, rData As Range, sData As String
    Dim kEtu As Long, kExe As Long, kMar As Long, nR As Long
    Dim kEtuD As Long, kExeD As Long, kMarD As Long, nRD As Long
    Dim sFml As String
    '--- recherche n° colonnes dans feuille en cours
    kEtu = Application.WorksheetFunction.Match("Etude", Range("1:1"), 0)
    kExe = Application.WorksheetFunction.Match("Exe", Range("1:1"), 0)
    kMar = Application.WorksheetFunction.Match("Marches", Range("1:1"), 0)
    nR = Range("A" & Rows.Count).End(xlUp).Row
    nR = nR - 1                         '--- dernière ligne n'est pas une donnée
    Debug.Print kEtu, kExe, kMar, nR    '--- pour info
    '--- sélection fichier antérieur
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Fichiers Excel", "*.xls*", 1
        .Title = "Choisir un fichier Excel"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show = True Then
            sFile = .SelectedItems(1)
            Debug.Print sFile
            Set wbData = Application.Workbooks.Open(sFile)
            Set wshData = wbData.Worksheets(1)
            Set fd = Nothing
        Else
            MsgBox "Annulé", , "Pour info"
            Set fd = Nothing
            Exit Sub
        End If
    End With
    '--- recherche n° colonnes dans wshData
    kEtuD = Application.WorksheetFunction.Match("Etude", wshData.Range("1:1"), 0)
    kExeD = Application.WorksheetFunction.Match("Exe", wshData.Range("1:1"), 0)
    kMarD = Application.WorksheetFunction.Match("Marches", wshData.Range("1:1"), 0)
    Debug.Print kEtuD, kExeD, kMarD
    nRD = wshData.Range("A" & wshData.Rows.Count).End(xlUp).Row
    nRD = nRD - 1       '--- la dernière ligne n'est pas une donnée
    '--- dénomination de la plage de recherche
    Set rData = wshData.Range(wshData.Cells(2, 1), wshData.Cells(nRD, Application.WorksheetFunction.Max(kEtuD, kExeD, kMarD)))
    Debug.Print wbData.Path, wbData.Name, wshData.Name, rData.Address
    sData = "'" & wbData.Path & "\[" & wbData.Name & "]" & wshData.Name & "'!" & rData.Address
    Debug.Print sData
    wbData.Close
    '--- inscription formules
    sFml = "=IFERROR(VLOOKUP($A2," & sData & ", 000, FALSE),"""")"
    Cells(2, kEtu).Formula = Replace(sFml, "000", kEtuD)
    Cells(2, kEtu).Copy
    Range(Cells(2, kEtu), Cells(nR, kEtu)).PasteSpecial xlPasteFormulas
    Cells(2, kExe).Formula = Replace(sFml, "000", kExeD)
    Cells(2, kExe).Copy
    Range(Cells(2, kExe), Cells(nR, kExe)).PasteSpecial xlPasteFormulas
    Cells(2, kMar).Formula = Replace(sFml, "000", kMarD)
    Cells(2, kMar).Copy
    Range(Cells(2, kMar), Cells(nR, kMar)).PasteSpecial xlPasteFormulas
    '--- cloture
    Set rData = Nothing
    Set wshData = Nothing
    Set wbData = Nothing
    MsgBox "Formules inscrites.", , "Pour info"
End Sub

Cordialement.

18/09/2021, 04h11
Alex020181

Bonjour,

Sur le principe ta demande est tout à fait faisable et tu as déjà une réponse.

Je complète en précisant que l'utilisation des fonctions imbriquées index et equiv te donnera le même résultat que la fonction recherchev (et en plus tu pourras faire une recherche vers la gauche si besoin alors que recherchev ne va que vers la droite).

Une question: tu demandes une macro pour insérer les formules et donc tu obtiens les formules insérées mais il est également possible de reporter directement les valeurs. Ainsi tu n'auras plus de recalculs interfichiers. Surtout que tes données sources sont des extractions cycliques donc l'utilisateur ne les modifie pas normalement donc il n'y a, du moins de mon point de vue, pas de raison de garder les formules. Tu serais gagnant à récupérer les valeurs uniquement.
20/09/2021, 09h00
olivier_alliance

Bonjour EricDgn et Alex020181,

1000 pardons pour le délai de réponse, je comptais faire cela ce weekend et puis c'est passé trop vite.
Bref...

@EricDgn, merci beaucoup pour votre proposition ! Je vais décrypter puis tester votre solution [elle est à des années-lumière de ma compréhension du vba, je vais prendre mon temps pour la comprendre ;) ]. Je vous ferai un retour courant de cette semaine.

@Alex020181, oui tout à fait ; ce serait plus pertinent de récupérer directement les valeurs. D'autant plus qu'un "copier - coller valeur" est appliqué manuellement par ma collègue une fois l'extraction faite. J'avais enregistré en macro la manoeuvre mais je n'y ai pas trouvé de valeur ajoutée par rapport à la méthode manuelle car à chaque fois il s'agit d'un nouveau fichier généré donc il faut insérer la macro. En l'insérant le bout de code généré par l'enregistrement dans une macro globale, il y a une vraie valeur ajoutée (ou alors il existe une fonction vba pour cela ; mais je ne l'ai pas trouvé, et les 2-3 solutions que j'ai regardé sur le web ne m'ont pas vraiment convaincu... et je n'ai clairement pas approfondi le sujet).

Bonjour,

Si seules les valeurs vous intéressent, il faut ajouter qq lignes pour copier - coller les valeurs (xlPasteVlues).

Code:

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
72
73
74
Option Explicit
 
Sub Reprendre()
    Dim fd As Office.FileDialog, sFile As String
    Dim wbData As Workbook, wshData As Worksheet, rData As Range, sData As String
    Dim kEtu As Long, kExe As Long, kMar As Long, nR As Long
    Dim kEtuD As Long, kExeD As Long, kMarD As Long, nRD As Long
    Dim sFml As String
    '--- recherche n° colonnes dans feuille en cours
    kEtu = Application.WorksheetFunction.Match("Etude", Range("1:1"), 0)
    kExe = Application.WorksheetFunction.Match("Exe", Range("1:1"), 0)
    kMar = Application.WorksheetFunction.Match("Marches", Range("1:1"), 0)
    nR = Range("A" & Rows.Count).End(xlUp).Row
    nR = nR - 1                         '--- dernière ligne n'est pas une donnée
    Debug.Print kEtu, kExe, kMar, nR    '--- pour info
    '--- sélection fichier antérieur
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Fichiers Excel", "*.xls*", 1
        .Title = "Choisir un fichier Excel"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show = True Then
            sFile = .SelectedItems(1)
            Debug.Print sFile
            Set wbData = Application.Workbooks.Open(sFile)
            Set wshData = wbData.Worksheets(1)
            Set fd = Nothing
        Else
            MsgBox "Annulé", , "Pour info"
            Set fd = Nothing
            Exit Sub
        End If
    End With
    '--- recherche n° colonnes dans wshData
    kEtuD = Application.WorksheetFunction.Match("Etude", wshData.Range("1:1"), 0)
    kExeD = Application.WorksheetFunction.Match("Exe", wshData.Range("1:1"), 0)
    kMarD = Application.WorksheetFunction.Match("Marches", wshData.Range("1:1"), 0)
    Debug.Print kEtuD, kExeD, kMarD
    nRD = wshData.Range("A" & wshData.Rows.Count).End(xlUp).Row
    nRD = nRD - 1       '--- la dernière ligne n'est pas une donnée
    '--- dénomination de la plage de recherche
    Set rData = wshData.Range(wshData.Cells(2, 1), wshData.Cells(nRD, Application.WorksheetFunction.Max(kEtuD, kExeD, kMarD)))
    Debug.Print wbData.Path, wbData.Name, wshData.Name, rData.Address
    sData = "'" & wbData.Path & "\[" & wbData.Name & "]" & wshData.Name & "'!" & rData.Address
    Debug.Print sData
    wbData.Close
    '--- inscription formules
    sFml = "=IFERROR(VLOOKUP($A2," & sData & ", 000, FALSE),"""")"
    '--- dans Etude
    Cells(2, kEtu).Formula = Replace(sFml, "000", kEtuD)
    Cells(2, kEtu).Copy
    Range(Cells(2, kEtu), Cells(nR, kEtu)).PasteSpecial xlPasteFormulas
    Range(Cells(2, kEtu), Cells(nR, kEtu)).Copy
    Range(Cells(2, kEtu), Cells(nR, kEtu)).PasteSpecial xlPasteValues
    '--- dans Exe
    Cells(2, kExe).Formula = Replace(sFml, "000", kExeD)
    Cells(2, kExe).Copy
    Range(Cells(2, kExe), Cells(nR, kExe)).PasteSpecial xlPasteFormulas
    Range(Cells(2, kExe), Cells(nR, kExe)).Copy
    Range(Cells(2, kExe), Cells(nR, kExe)).PasteSpecial xlPasteValues
    '--- dans Marche
    Cells(2, kMar).Formula = Replace(sFml, "000", kMarD)
    Cells(2, kMar).Copy
    Range(Cells(2, kMar), Cells(nR, kMar)).PasteSpecial xlPasteFormulas
    Range(Cells(2, kMar), Cells(nR, kMar)).Copy
    Range(Cells(2, kMar), Cells(nR, kMar)).PasteSpecial xlPasteValues
    '--- cloture
    Set rData = Nothing
    Set wshData = Nothing
    Set wbData = Nothing
    MsgBox "Valeurs inscrites.", , "Pour info"
End Sub

Cordialement.

20/09/2021, 14h48
olivier_alliance

Merci beaucoup pour cet ajout EricDgn.

J'ai testé votre script en l'état et j'ai une erreur d'exécution.

Pour débogage, voici la numérotation des lignes pour votre code :
ligne 1 = Sub Reprendre(),
ligne 72 = End Sub.

Durant le test, j'ai eu l'erreur 1004 à partir de la
ligne 8 = kEtu = Application.WorksheetFunction.Match("Etude", Range("1:1"), 0).

J'ai remplacé Range("1:1") sur 6 lignes comme suit :
ligne 8 = Range("AF9:AF400"),
ligne 9 = Range("AG9:AG400"),
ligne 10 = Range("AH9:AH400"),
ligne 35 = Range("AF9:AF400"),
ligne 36 = Range("AG9:AG400"),
ligne 37 = Range("AH9:AH400"),
"9" car les titres des colonnes sont sur ligne 9 du fichier Excel.

Cela passe.
J'arrive à la fenêtre demandant le fichier antérieur et pointe vers l'ancien fichier.

J'ai alors l'erreur 91

Citation:

variable objet ou variable bloc With non définie

en ligne 26 = Set wshData = wbData.Worksheets(1).

Sauriez-vous comment résoudre cela, svp ?
20/09/2021, 22h24
Alex020181

2 pièce(s) jointe(s)

Bonjour Olivier,

Voici en PJ une proposition de code pour répondre à ta demande.

Pièce jointe 605068

Il te suffit de compléter les titres à rechercher par fichier en B3:E4 puis de cliquer sur le bouton.
2 fenêtres vont s'ouvrir successivement; il faudra naviguer dedans pour aller double cliquer d'abord sur le DDP old puis sur le DDP.

Dans les 2 fichiers les feuilles concernées doivent être en première position.
Dans les 2 fichiers les titres des colonnes doivent être en ligne 1.

Les 2 fichiers DDP old et DDP ne doivent pas être ouverts.
Par sécurité supplémentaire aucun autre fichier Excel que celui-ci ne doit être ouvert.

Le nombre de lignes dans les 2 fichiers n'a pas d'importance.

Teste et dis nous.

1 pièce(s) jointe(s)

Bonjour,

Oui, il y a de multiples façons de faire, dont celle-ci, adaptée au cas où le tableau des données ne commence pas à la ligne 1, mais quand même en colonne A:

Code:

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
72
73
74
75
76
77
78
79
80
81
82
83
Option Explicit
 
Sub Reprendre()
    Dim fd As Office.FileDialog, sFile As String
    Dim wbData As Workbook, wshData As Worksheet, rData As Range, sData As String
    Dim kEtu As Long, kExe As Long, kMar As Long, nR As Long
    Dim kEtuD As Long, kExeD As Long, kMarD As Long, nRD As Long
    Dim sFml As String
    Dim kRow1 As Long, kRow2 As Long, kRow1D As Long, kRow2D As Long
    '--- recherche n° ligne des titres dans feuille courante
    '--- suppose titre "Numéro de dossier" en colonne A
    kRow1 = Application.WorksheetFunction.Match("Numéro de dossier", Range("A:A"), 0)
    '--- recherche n° colonnes dans feuille en cours
    kEtu = Application.WorksheetFunction.Match("Etude", Rows(kRow1), 0)
    kExe = Application.WorksheetFunction.Match("Exe", Rows(kRow1), 0)
    kMar = Application.WorksheetFunction.Match("Marches", Rows(kRow1), 0)
    kRow1 = kRow1 + 1                               '--- première ligne avec des données
    kRow2 = Range("A" & Rows.Count).End(xlUp).Row   '--- dernière ligne (qui n'est pas une donnée mais indique le nb de dossiers)
    kRow2 = kRow2 - 1                               '--- dernière ligne avec des données
    Debug.Print kRow1, kRow2, kEtu, kExe, kMar      '--- pour info
    '--- sélection du fichier antérieur
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Fichiers Excel", "*.xls*", 1
        .Title = "Choisir un fichier Excel"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show = True Then
            sFile = .SelectedItems(1)
            Debug.Print sFile
            Set wbData = Application.Workbooks.Open(sFile)
            Set wshData = wbData.Worksheets(1)
            Set fd = Nothing
        Else
            MsgBox "Annulé", , "Pour info"
            Set fd = Nothing
            Exit Sub
        End If
    End With
    '--- recherche n° ligne des titres dans wshData
    '--- suppose "Numéro de dossier" en colonne A
    kRow1D = Application.WorksheetFunction.Match("Numéro de dossier", wshData.Range("A:A"), 0)
    '--- recherche n° colonnes dans wshData
    kEtuD = Application.WorksheetFunction.Match("Etude", wshData.Rows(kRow1D), 0)
    kExeD = Application.WorksheetFunction.Match("Exe", wshData.Rows(kRow1D), 0)
    kMarD = Application.WorksheetFunction.Match("Marches", wshData.Rows(kRow1D), 0)
    kRow1D = kRow1D + 1                             '--- n° première ligne avec des données
    kRow2D = wshData.Range("A" & wshData.Rows.Count).End(xlUp).Row
    kRow2D = kRow2D - 1                             '--- n° dernière ligne avec des données
    Debug.Print kRow1D, kRow2D, kEtuD, kExeD, kMarD '--- pour info
    '--- dénomination de la plage de recherche
    Set rData = wshData.Range(wshData.Cells(kRow1D, 1), wshData.Cells(kRow2D, Application.WorksheetFunction.Max(kEtuD, kExeD, kMarD)))
    Debug.Print wbData.Path, wbData.Name, wshData.Name, rData.Address   '--- pour info
    sData = "'" & wbData.Path & "\[" & wbData.Name & "]" & wshData.Name & "'!" & rData.Address
    Debug.Print sData                               '--- pour info
    wbData.Close
    '--- inscription formules
    sFml = "=IFERROR(VLOOKUP($A" & kRow1 & "," & sData & ", 000, FALSE),"""")"
    '--- dans Etude
    Cells(kRow1, kEtu).Formula = Replace(sFml, "000", kEtuD)
    Cells(kRow1, kEtu).Copy                             '--- copie formules
    Range(Cells(kRow1, kEtu), Cells(kRow2, kEtu)).PasteSpecial xlPasteFormulas
    Range(Cells(kRow1, kEtu), Cells(kRow2, kEtu)).Copy  '--- copie résultats (valeurs)
    Range(Cells(kRow1, kEtu), Cells(kRow2, kEtu)).PasteSpecial xlPasteValues
    '--- dans Exe
    Cells(kRow1, kExe).Formula = Replace(sFml, "000", kExeD)
    Cells(kRow1, kExe).Copy                             '--- copie formules
    Range(Cells(kRow1, kExe), Cells(kRow2, kExe)).PasteSpecial xlPasteFormulas
    Range(Cells(kRow1, kExe), Cells(kRow2, kExe)).Copy  '--- copie résultats (valeurs)
    Range(Cells(kRow1, kExe), Cells(kRow2, kExe)).PasteSpecial xlPasteValues
    '--- dans Marche
    Cells(kRow1, kMar).Formula = Replace(sFml, "000", kMarD)
    Cells(kRow1, kMar).Copy                             '--- copie formules
    Range(Cells(kRow1, kMar), Cells(kRow2, kMar)).PasteSpecial xlPasteFormulas
    Range(Cells(kRow1, kMar), Cells(kRow2, kMar)).Copy  '--- copie résultats (valeurs)
    Range(Cells(kRow1, kMar), Cells(kRow2, kMar)).PasteSpecial xlPasteValues
    '--- cloture
    Set rData = Nothing
    Set wshData = Nothing
    Set wbData = Nothing
    MsgBox "Valeurs inscrites.", , "Pour info"
End Sub

A tester.
Cordialement.

21/09/2021, 05h39
Alex020181

2 pièce(s) jointe(s)

@Olivier

Citation:

"9" car les titres des colonnes sont sur ligne 9 du fichier Excel.

Oups je n'avais pas vu ça. Tes fichiers commençaient en ligne 1 donc j'avais fait avec ça.

Bon pas grave. Je t'ai fait une V2. Même principe que la V1: tu complètes le tableau en B3:F4 et tu cliques.
Le tableau de paramètres te permet de définir les titres des colonnes et le numéro de la ligne des titres pour chaque fichier.

Teste et dis nous.

@Éric
Attention avec la méthode copy/paste. Si tu fais comme ça l'utilisateur perd les données qu'il avait copié en mémoire. Cela pourrait être gênant.
Je te conseille d'utiliser AutoFill pour étendre les formules puis zone.value = zone.value pour remplacer les formules par leur résultat. (voir PJ).
C'est un conseil hein pas une critique ;)
21/09/2021, 11h13
EricDgn

Bonjour,

@Alex. J'avais d'abord utilisé Autofill, mais ayant observé qu'il y avait des lignes de données déjà formatées (colorées) j'ai finalement opté pour Copy - PasteSpecial qui conserve ces formats. Autofill les écrase pour mettre le formatage de la cellule de départ.
Par contre je n'avais pas pensé à utiliser zone.Value = zone.Value. Bonne idée.

Cordialement.

Bonjour EricDgn et Alex020181.

Tout d'abord, je vous remercie à nouveau pour votre aide fort appréciable.

Effectivement, concernant le démarrage des colonnes, j'ai épuré le fichier mais je n'aurais pas dû supprimer les 8 1ères lignes... désolé.
Pour la colorisation des cellules, ne pas les prendre en compte car c'est ma collègue qui fait sa colorisation pour s'y retrouver selon les avancées et retards des dossiers.

Je pense que vous allez très -trop ?- loin dans les scripts.
Je m'explique : J'ai créé un batch qu'elle exécute en début de semaine (je suis un peu plus à l'aise dans les commandes dos :P )

Voici le batch:
Code:

1 2 3 4 5 6 7 8 @ECHO OFF DEL /f /q "D:\TESTDDP\Ancien\DDPOLD.xls" COPY "D:\TESTDDP\DESCENTE DE PORTEFEUILLE.xls" "D:\TESTDDP\Ancien\" RENAME "D:\TESTDDP\Ancien\DESCENTE DE PORTEFEUILLE.xls" DDPOLD.xls MOVE "D:\TESTDDP\DESCENTE DE PORTEFEUILLE.xls" "D:\TESTDDP\Ancien\" set datejour=%date:~6,4%%date:~3,2%%date:~0,2% RENAME "D:\TESTDDP\Ancien\DESCENTE DE PORTEFEUILLE.xls" "DDP_%datejour%.xls" EXIT
Description :
* suppression du fichier DDPOLD.xls dans le dossier \Ancien
* copie du fichier DESCENTE DE PORTEFEUILLE.xls dans le dossier \Ancien et renommage en DDPOLD.xls
* déplacement du fichier DESCENTE DE PORTEFEUILLE.xls dans le dossier \Ancien et renommage en DDP_date_du_jour.xls

Ensuite, elle génère le fichier DESCENTE DE PORTEFEUILLE.xls via sa requête SAP BO.
Dans ce fichier, elle met à jour manuellement les colonnes AF, AG et AH.
Comme il y a des dossiers qui reviennent chaque semaine, pour éviter la saisie manuelle elle applique une recherchev pointant vers le fichier \Ancien\DDPOLD.xls.
Elle renseigne manuellement ces colonnes pour les nouveaux dossiers.

La macro vba que je ne sais pas faire devrait tout automatiser pour :
- Trouver la correspondance entre DESCENTE DE PORTEFEUILLE.xls et \Ancien\DDPOLD.xls pour remplir les colonnes AF, AG et AH selon le numéro de dossier référencé en colonne A
- mettre à vide les cellules dont la valeur est à 0 dans les colonnes AF, AG et AH
- copier-coller la valeur dans les colonnes AF, AG et AH pour enlever toute référence à des formules

Remarque :
- Le nombre de lignes et l'ordre d'apparition des numéros de dossiers (colonne A) sont variables.

J'espère être plus clair pour vous éviter de perdre du temps :oops:

Je ne sais pas si cela aide, mais en dernière précision, les emplacements de fichiers énoncés sont temporaires. Les emplacements réels sont plutôt du style "U:\10 Commerce\00 Chargées Commerce\Descentes de portefeuilles PS\"

21/09/2021, 17h46
Alex020181

C'est ce que fais mon code.

- Elle complète le tableau de paramètres (qui peut être enregistré une fois complété pour les semaines suivantes pour ne pas avoir à le ressaisir encore une fois)
- Elle clique sur le bouton
- Elle va sélectionner son fichier DDP old contenant les données à reprendre (donc le fichier \Ancien\DDPOLD.xls) dans la première fenêtre
- Elle va sélectionner son fichier DDP contenant les données à mettre à jour (donc le fichier DESCENTE DE PORTEFEUILLE.xls via sa requête SAP BO) dans la seconde fenêtre
- Le code mouline
- Le fichier DESCENTE DE PORTEFEUILLE.xls via sa requête SAP BO est mis à jour avec les données du fichier \Ancien\DDPOLD.xls

Mon fichier est, si tu préfères, un outil qui permet de mettre à jour le fichier DESCENTE DE PORTEFEUILLE.xls en tierce partie. Il ne faut pas prendre son code pour le copier coller dans la DDP.

Il faut l'utiliser juste après la création de l'extraction BO.
22/09/2021, 18h27
olivier_alliance

Bonjour EricDgn et Alex020181.

@Alex020181 = Yes, cela fonctionne "superbien" :yaisse3:

Un grand grand grand merci à vous 2 :hola:

Ma prochaine étape : décortiquer vos scripts pour bien les comprendre :zen:
22/09/2021, 19h17
Alex020181

Cool.

Merci du retour. Tout le monde ne le fait pas.

Bon courage si tu décides de décortiquer le code. Il n'est pas des plus simples pour commencer.