Macro table de correspondance au sein classeur unique

Bonjour à toutes et tous,

Imaginons un classeur contenant 2 onglets : Table et Base

Table : table de correspondance entre d'anciens codes et de nouveaux code (alpha, numérique et ou alpha numérique)

Base : une base données (énormément de valeurs) contenant en colonne A dans mon exemple des valeurs avec des anciens codes ou nouveaux codes

Je cherche via une macro (j'arrive par formule recherche V par exemple mais avec ajout d'une colonne supplémentaire que je veux absolument éviter de créer qui plus est avec obligation d'étirer la formule au fur et à mesure des imports de données, je voudrais automatiser un peu plus) remplacer dans base colonne A les anciens codes si présents par les nouveaux codes conformément à la table de correspondance. Les anciens codes seraient écrasés par les nouveaux. (pas besoin de conserver historique)

En faisant une recherche sur le forum, j'ai trouvé le post ci après qui se rapproche le plus de ce que je souhaite réaliser mais avec plusieurs classeurs, un contenant la base et un autre la table et qui ne gère pas les codes non présents dans la table de données (en outre get open file name n'est pas compatible sous Excel pour Mac).

https://forum.excel-pratique.com/excel/rechercher-et-remplacer-avec-une-table-de-correspondance-t59293.html

Je joins un classeur exemple minimaliste sur la forme et le fond (la base réelle pouvant contenir des milliers de lignes).

Ce fichier exemple contient 3 feuilles : la table de correspondance, base avant macro et base après macro. Mais le fichier final lui ne doit contenir que 2 onglets table et base (tel que imagé pour le cheminement via base avant macro et base après macro).

J'ai essayé d'exprimer ma requête le plus simplement possible en espérant que cela donnera envie à une personne de ce forum de se pencher sur mon problème et me donner un coup de pouce.

Merci

Cordialement

Hugues

Bonjour,

Il faut être sûr qu'aucun ancien code ne se retrouve en nouveau code...

Et tu ne pourrais pas trouver un PC pour réaliser cette opération (ponctuelle) ?

La méthode rêvée pour traiter ça est d'utiliser le Dictionnaire ! Mais pas sur Mac !!

Cordialement.

Bonjour,

Merci MFERRAND de t'intéresser à mon problème.

J'ai une machine virtuelle windows sous mon Mac avec Excel 2010 windows à laquelle je peux faire appel si la solution sous windows répond bien à mon besoin d'automatisation.

Autrement oui il est certains qu'aucuns anciens codes ne puissent se retrouver en nouveau codes car la nouvelle codification à justement introduit l'obligation de caractères supplémentaires ou de codes non déjà utilisés.

Je ne connais pas la notion de "DICTIONNAIRE" (chouette encore un truc qu'il va falloir que j'essaye d'assimiler après recherche)

Je reste donc à ton écoute pour tes conseils et une proposition de code faisant appel à ce dictionnaire que j'essayerais d'adapter.

Merci

Cordialement

Hugues

MFerrand a écrit :

La méthode rêvée pour traiter ça est d'utiliser le Dictionnaire ! Mais pas sur Mac !!

Cordialement.

Bonjour,

voir : http://boisgontierjacques.free.fr/

où il utilise les collections...

Mais c'est là que je vois que mon excel windows est mieux que mon excel Mac pour pas mal de raisons et de loin !

P.

patrick1957 a écrit :

MFerrand a écrit :

La méthode rêvée pour traiter ça est d'utiliser le Dictionnaire ! Mais pas sur Mac !!

Cordialement.

Bonjour,

voir : http://boisgontierjacques.free.fr/

où il utilise les collections...

Mais c'est là que je vois que mon excel windows est mieux que mon excel Mac pour pas mal de raisons et de loin !

P.

Bonjour Patrick,

Merci pour le lien je vais aller voir.

C'est certains que Excel mac est beaucoup plus limité que Excel windows, et c'est encore plus le cas avec Excel Mac 2015 (autant Excel 2011 Mac avait été une avancé au contraire) qui ne gère même plus la création des userform par exemple.

Cordialement

Hugues

Bonjour,

Salut Patrick !

Effectivement, la collection peut s'avérer une solution...

En tout cas voici la version dico (plus rapide ainsi que le souligne Boisgontier).

Si tu peux la faire fonctionner...

Sub MAJcode()
    Dim d As Object, n%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d(.Cells(i, 1).Value) = .Cells(i, 2)
        Next i
    End With
    With Worksheets("BASE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            If d.exists(.Cells(i, 1).Value) Then _
             .Cells(i, 1) = d(.Cells(i, 1).Value)
        Next i
        .Activate
    End With
End Sub

J'ai mis un bouton pour la tester sur la feuille TABLE.

Cordialement.

Bonjour,

Mferrand merci beaucoup pour ta contribution qui fonctionne parfaitement sous mon environnement Excel windows

Je vais adapter ton code sur ma base réelle car dés à présent cela me permet d'avancer même si je suis obligé de changer d'environnement système d'exploitation.

Tout en continuant mes recherches sur une solution via COLLECTION comme évoqué par Patrick.

Je laisse encore un peu le post comme non résolu pour continuer à obtenir des pistes dans ce sens

Encore merci Mferrand.

Cordialement

Hugues

Bonjour à toutes et tous,

Patrick, Mferrand encore une fois merci de l'intérêt et les conseils.

Mferrand je garde ton code notamment pour sa rapidité d'excécution, même si je ne peux le faire tourner sur mon Excel MAC 2011.

Cela m'a donné envie d'approfondir mes connaissances sur dictionary.

Je partage ce code issu de mes recherches (qui n'est pas de ma création je remercie son auteur) qui à priori fonctionne que ce soit sous windows et mac (je n'ai pas encore complètement testé sur une très grande base et pour tous les cas de figure et peut être est il largement moins rapide que la solution via dictionary de MFERRAND)

Je reste à l'écoute de vos conseils et remarques.

Sub MAJcode()
Application.ScreenUpdating = False
Dim n As Integer
Dim d() As String
With Worksheets("TABLE")
n = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim Preserve d(2, n + 1)
For i = 1 To n
d(1, i) = .Cells(i, 1).Value
d(2, i) = .Cells(i, 2).Value
Next i
End With
With Worksheets("BASE")
m = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 1 To m
For j = 1 To n
If d(1, j) = .Cells(i, 1).Value Then _
.Cells(i, 1).Value = d(2, j)
Next j
Next i
.Activate
End With
End Sub

Merci

Cordialement

Hugues

Bonsoir,

Je te proposerai volontiers de la modifier comme suit :

Sub MAJcodeTablo()
    Dim Cold(), Cnew(), n%, i%, j%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim Cold(1 To n - 1): ReDim Cnew(1 To n - 1)
        For i = 2 To n
            Cold(i - 1) = .Cells(i, 1)
            Cnew(i - 1) = .Cells(i, 2)
        Next i
    End With
    With Worksheets("BASE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            j = WorksheetFunction.Match(.Cells(i, 1), Cold, 0)
            If Err.Number = 0 Then
                .Cells(i, 1) = Cnew(j)
            Else
                Err.Clear
            End If
        Next i
        .Activate
    End With
End Sub

Je peux expliquer pour chaque ligne les raisons des modifications... mais l'intéressant est que tu la testes.

Je pense par ailleurs que l'utilisation d'une Collection devrait être plus rapide, mais je suis sur un truc un peu fastidieux à écrire et j'en ai trop d'autres en attente pour me lancer là-dedans dans l'immédiat.

Cordialement.

Bonjour MFERRAND,

Une nouvelle fois merci pour ta contribution.

Je vais tester ton code mais déjà en première lecture je comprend qu'il y'a un test d'erreur et c'est une bonne chose.

Je comprend tout a fait et je trouve cela normal que tu ne puisses pas passer plus de temps pour une solution via collection; tout d'abord parce que tu as résolu mon problème si windows et en plus améliorer le code fonctionnant sous MAC. J'ai donc une solution fonctionnelle.

Merci

Cordialement

Hugues

Bonsoir,

Le test d'erreur joue un rôle : si erreur la clé est déjà la nouvelle, on ne remplace pas, on passe à la suivante...

Pour boucler, une dernière à tester...

Sub MAJcodeCollec()
    Dim d As New Collection, n%, i%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d.Add .Cells(i, 2), CStr(.Cells(i, 1))
        Next i
    End With
    With Worksheets("BASE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            .Cells(i, 1) = d(CStr(.Cells(i, 1)))
        Next i
    End With
End Sub

Si tu peux nous informer des avantages relatifs des unes et autres selon tes tests, ça nous intéresse...

Cordialement.

Bonjour MFERRAND, Bonjour à toutes et tous

Merci du temps consacré.

Me voilà en possession d'un panel complet de solutions.

J'adapte les différents codes à ma base réelle et je ne manquerais pas de revenir vers vous d'ici une petite semaine pour un comparatif et vous dire pourquoi j'ai un code plutôt que l'autre.

Merci beaucoup

Cordialement

Hugues

Bonjour MFERRAND, Bonjour à toutes et tous,

Premiers essais sur une partie de ma base réelle et un bug :" Erreur d'exécution « 457 »:Cette clé est déjà associée à un élément de cette collection" avec le code dit "collection" alors que aucun problème avec l'autre code optimisé par MFERRAND.

Je joins un classeur exemple avec des données réelles non confidentielles en l'état, car c'est bien avec ce jeu de données que le problème survient, alors que pas de problèmes avec le fichier exemple initial. Sans que je n'arrive à me l'expliquer,

Je continue de tester et de tenter des modifications mais vos avis sont les bienvenus.

Cordialement

Hugues

A-priori rien de surnaturel ni de problématique ! La table est fausse !!!

Par définition, la table de correspondance implique deux colonnes : ancien code / nouveau code. Soit à tout ancien code correspond un nouveau code, sans doublon et sans vide (si un élément n'existe pas la ligne doit disparaître.

L'erreur apparaît sur cette version car l'ancien code est la clé : une clé vide n'est pas rejetée, mais si on essaie de l'attribuer à plusieurs éléments ça plante ! Elle ne peut être doublonnée.

Si les autres versions ne plante pas avec une telle table, cela ne veut pas dire qu'elles vont fonctionner sans erreur.

Le dico élimine naturellement les doublons lors de sa constitution. Je pensais qu'il ne devrait pas accepter une clé vide (?) mais si c'est le cas, il n'y en aura qu'une.

Quant au tableau, tout sera en tableau mais si doublon, seul le premier trouvé sera considéré...

La situation prévue est : pas de doublons dans les anciens codes, correspondance de chaque ancien code avec un nouveau. Et pas de code (ancien) inexistant ! Si la table comprend des vides, il faut mettre un test dans toutes les versions pour les éliminer dès l'entrée ! Pure logique ! Un ancien code inexistant ne saurait être remplacé !

Le cas où 2 anciens codes sont remplacés par un même nouveau code est par contre envisageable et devrait passer sur toutes les versions.

Cordialement.

Bonjour à toutes et tous, Bonjour MFERRAND,

Je suis toujours bluffé par les qualités et la rapidité de tes réponses je t'envois donc de nouveau un merci

"La table est fausse" tout simplement, j'adore et le smiley qui va avec encore plus. Car cela montre bien que j'ai encore beaucoup de chose à apprendre moi qui fonctionne par tâtonnement.

Je vais donc relire ton message plusieurs fois, continuer mes essais de compréhension des codes car là en première lecture à mon niveau cela ne me parait pas encore aussi simple et clair que pour toi.

Mais que j'apprécie tes remarques et ton aide.

merci beaucoup

Cordialement

Hugues

Tu vas vite t'y retrouver !

Il est certain qu'un code ancien vide va foutre le bazar, sauf si l'absence de code ancien avait pour correspondance un unique nouveau code... ce qui n'est pas le cas.

Si tu dois extraire les codes d'une table comportant des vides, et que tu ne parviens pas à mettre en place les conditions pour ne pas prélever dans ce cas, manifeste-toi...

Bon weekend.

Bonjour à toutes et tous, Bonjour Patrick et MFerrand,

Grace à vos conseils, et je tiens encore une fois à vous remercier, je suis arrivé à mes fins et j'ai pu créer une macro correspondant à mon besoin.

Résumé de mon besoin :

A partir d'un export de notre ancien logiciel de paye qui me génère plusieurs feuilles je veux créer une seule feuille de synthèse avec des entêtes, des contenus, des rajouts via calcul etc.. parfois différents des feuilles initiales et surtout une table de correspondance (cf macro nommée correspondance dans mon code, crée via l'aide de Mferrand) pour gérer les noms des magasins.

J'ai retenu la solution via méthode collection, car compatible sur Excel Mac (contrairement à méthode via Dico), c'est aussi celle que j'ai la mieux comprise et pu adapter et enfin les temps de traitements sur ma base réelle sont bons (mois de 10 secondes pour environs 20 feuilles de 300 lignes et 30 colonnes en moyenne chacune).

Même si je tâtonne encore un peu sur la compréhension de la partie du code ci après pour traiter et appliquer les résultats issus de la table de correspondance aux colonnes de mon choix.

Je ne sais pas par exemple comment modifier la macro ave une table qui aurait les anciens codes magasins en colonne D et les nouveaux en C(ici ancien code en A et nouveau en B) et qui appliquerait les modification issus de la lecture de la colonne C sur la feuille finale (ici en colonne A).

With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d.Add .Cells(i, 2), CStr(.Cells(i, 1))
        Next i
    End With
    With Worksheets("CADOR")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            .Cells(i, 1) = d(CStr(.Cells(i, 1)))
        Next i

Je concède que ce message est certainement un peu long, surtout pour un post résolu mais MFERRAND vous vouliez avoir mon retour.

Ci après mon code finalisé (je reste bien entendu encore à l'écoute vos conseils d'améliorations) et 2 fichiers un comprenant la macro et un jeu de données fictives avant exécution de la macro nommé CADOR et l'autre le jeu de données fictives.

Merci

Cordialement

Hugues

Sub Cador()

Dim debut As Date, temps As Date, fin As Date
debut = Time

Dim WS As Worksheet

On Error Resume Next
    Set WS = ThisWorkbook.Worksheets("CADOR")
On Error GoTo 0
If Not WS Is Nothing Then
      Sheets("CADOR").Activate
      Sheets("CADOR").Range("A1").Select
Else
    Sheets.Add.Name = "CADOR"
    Range("A1").Select

End If

Call Fusion
Call InsertColDE
Call FormuleColD
Call FormuleColE
Call ColSpeValDE
Call SuppColABC
Call FormuleColW
Call ColSpeValW
Call FormuleColX
Call ColSpeValX
Call FormuleColY
Call ColSpeValY
Call FormuleColZ
Call ColSpeValZ
Call EnteteCador
Call CreafeuillTable
Call Correspondance
Call SuppFeuilles

Sheets("CADOR").Activate
Range("A1").Select

fin = Time
temps = fin - debut
MsgBox ("Mise en forme Export Cador terminé !" & Chr(10) & Chr(10) & "Temps de traitement : " & temps & Chr(10) & Chr(10) & "Mettre à jour table de correspondance" & Chr(10) & "si création nouveau magasin et ou société !")

End Sub

Sub Fusion()

Dim Lg&, Sh As Worksheet, f As Worksheet

            Set f = Sheets("CADOR")
        f.Range("a1:am" & f.[a1048576].End(xlUp).Row).ClearContents    'efface Récap

        For Each Sh In Worksheets
            If Sh.Name <> f.Name And Sh.Name <> "TABLE" Then         'feuilles à ne pas traiter
              Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row
                Sh.Range("a2:am" & Lg).Copy Destination:= _
                f.Range("a" & Rows.Count).End(xlUp)(2)
            End If
        Next

Sheets("CADOR").Move Before:=Sheets(1)
Range("A1").Select

End Sub

Sub InsertColDE()

Sheets("CADOR").Select
Range("D:E").Insert Shift:=xlToRight

End Sub

Sub FormuleColD()
Dim DernièreLigne As Long

DernièreLigne = WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 2).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row)

        For lignes = DernièreLigne To 2 Step -1

        If Cells(lignes, 2) <> "" And Cells(lignes, 3) <> "" Then
Range("D" & lignes).FormulaLocal = "=CONCATENER((" & Range("B" & lignes).Address & ");(" & Range("C" & lignes).Address & "))"

        End If
    Next lignes

End Sub

Sub FormuleColE()
Dim DernièreLigne As Long

DernièreLigne = WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 2).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row)

        For lignes = DernièreLigne To 2 Step -1

        If Cells(lignes, 1) <> "" Then
Range("E" & lignes).FormulaLocal = "=DATE(ANNEE(" & Range("A" & lignes).Address & "); MOIS(" & Range("A" & lignes).Address & ");1)"

        End If
    Next lignes

End Sub

Sub ColSpeValDE()

Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

Columns("E:E").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub

Sub SuppColABC()

Sheets("CADOR").Select
Range("A:A,B:B,C:C").Delete Shift:=xlToLeft

End Sub

Sub FormuleColW()
Dim DernièreLigne As Long

DernièreLigne = WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row)

    '
    For lignes = DernièreLigne To 2 Step -1

        If Cells(lignes, 1) <> "" Then
Range("W" & lignes).FormulaLocal = "=ARRONDI(((" & Range("S" & lignes).Address & "+" & Range("T" & lignes).Address & "+" & Range("U" & lignes).Address & ")/(52/12))*" & Range("L" & lignes).Address & "/6;0)"

        End If
    Next lignes

End Sub

Sub ColSpeValW()

Columns("W:W").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub

Sub FormuleColX()
Dim DernièreLigne As Long

DernièreLigne = WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row)

    For lignes = DernièreLigne To 2 Step -1

        If Cells(lignes, 1) <> "" Then
Range("X" & lignes).FormulaLocal = "=SI(" & Range("E" & lignes).Address & "=""Contrat à durée déterminée"";" & Range("K" & lignes).Address & ";0)"

        End If
    Next lignes

End Sub

Sub ColSpeValX()

Columns("X:X").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub

Sub FormuleColY()
Dim DernièreLigne As Long

DernièreLigne = WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row)

       For lignes = DernièreLigne To 2 Step -1

        If Cells(lignes, 1) <> "" Then
Range("Y" & lignes).FormulaLocal = "=" & Range("K" & lignes).Address & "+" & Range("W" & lignes).Address & ""

        End If
    Next lignes

End Sub

Sub ColSpeValY()

Columns("Y:Y").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub

Sub FormuleColZ()
Dim DernièreLigne As Long

DernièreLigne = WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row)

    For lignes = DernièreLigne To 2 Step -1

        If Cells(lignes, 1) <> "" Then
Range("Z" & lignes).FormulaLocal = "=" & Range("H" & lignes).Address & "+" & Range("I" & lignes).Address & ""

        End If
    Next lignes

End Sub

Sub ColSpeValZ()

Columns("Z:Z").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

End Sub

Sub EnteteCador()

Sheets("CADOR").Activate

Sheets("CADOR").Range("A1").FormulaR1C1 = "Magasin"
Sheets("CADOR").Range("B1").FormulaR1C1 = "Date de règlement"
Sheets("CADOR").Range("C1").FormulaR1C1 = "Nom du salarié"
Sheets("CADOR").Range("D1").FormulaR1C1 = "Prénom du salarié"
Sheets("CADOR").Range("E1").FormulaR1C1 = "Contrat de travail"
Sheets("CADOR").Range("F1").FormulaR1C1 = "Salaires"
Sheets("CADOR").Range("G1").FormulaR1C1 = "Primes"
Sheets("CADOR").Range("H1").FormulaR1C1 = "Rupture"
Sheets("CADOR").Range("I1").FormulaR1C1 = "Protocole"
Sheets("CADOR").Range("J1").FormulaR1C1 = "Charges"
Sheets("CADOR").Range("K1").FormulaR1C1 = "Heures"
Sheets("CADOR").Range("L1").FormulaR1C1 = "Jours CP"
Sheets("CADOR").Range("M1").FormulaR1C1 = "Heures complementaires 10%"
Sheets("CADOR").Range("N1").FormulaR1C1 = "Heures complementaires 25%"
Sheets("CADOR").Range("O1").FormulaR1C1 = "Heures complementaires 50%"
Sheets("CADOR").Range("P1").FormulaR1C1 = "Heures complementaires 10% €"
Sheets("CADOR").Range("Q1").FormulaR1C1 = "Heures complementaires 25% €"
Sheets("CADOR").Range("R1").FormulaR1C1 = "Heures complementaires 50% €"
Sheets("CADOR").Range("S1").FormulaR1C1 = "Base contrat"
Sheets("CADOR").Range("T1").FormulaR1C1 = "35 a 39"
Sheets("CADOR").Range("U1").FormulaR1C1 = "39 forfait"
Sheets("CADOR").Range("V1").FormulaR1C1 = "R[REMUNERATION_NETTE]"
Sheets("CADOR").Range("W1").FormulaR1C1 = "Heures CP"
Sheets("CADOR").Range("X1").FormulaR1C1 = "Heures CDD"
Sheets("CADOR").Range("Y1").FormulaR1C1 = "Heures W"
Sheets("CADOR").Range("Z1").FormulaR1C1 = "Exceptionnel"

End Sub

Sub CreafeuillTable()

Dim WS2 As Worksheet

On Error Resume Next
    Set WS2 = ThisWorkbook.Worksheets("TABLE")
On Error GoTo 0
If Not WS2 Is Nothing Then
      Sheets("TABLE").Activate
      Sheets("TABLE").Range("A1").Select
Else
    Sheets.Add.Name = "TABLE"
Sheets("TABLE").Range("A1").FormulaR1C1 = "CADOR"
Sheets("TABLE").Range("A2").FormulaR1C1 = "CCAU0"
Sheets("TABLE").Range("A3").FormulaR1C1 = "CCRE0"
Sheets("TABLE").Range("A4").FormulaR1C1 = "BNB0"
Sheets("TABLE").Range("A5").FormulaR1C1 = "BREA0"
Sheets("TABLE").Range("A6").FormulaR1C1 = "SCOT0"
Sheets("TABLE").Range("A7").FormulaR1C1 = "MULT0"
Sheets("TABLE").Range("A8").FormulaR1C1 = "MULTI_BLAI0"
Sheets("TABLE").Range("A9").FormulaR1C1 = "MUZ0"
Sheets("TABLE").Range("A10").FormulaR1C1 = "ESPR0"
Sheets("TABLE").Range("A11").FormulaR1C1 = "GDES0"
Sheets("TABLE").Range("A12").FormulaR1C1 = "CELI0"
Sheets("TABLE").Range("A13").FormulaR1C1 = "VIBS2"
Sheets("TABLE").Range("A14").FormulaR1C1 = "LANG1"
Sheets("TABLE").Range("A15").FormulaR1C1 = "LANG2"
Sheets("TABLE").Range("A16").FormulaR1C1 = "VIBS1"
Sheets("TABLE").Range("A17").FormulaR1C1 = "LANG3"
Sheets("TABLE").Range("B1").FormulaR1C1 = "HUGUES"
Sheets("TABLE").Range("B2").FormulaR1C1 = "Cache AURAY"
Sheets("TABLE").Range("B3").FormulaR1C1 = "Cache REDON"
Sheets("TABLE").Range("B4").FormulaR1C1 = "Bonobo REDON"
Sheets("TABLE").Range("B5").FormulaR1C1 = "Breal REDON"
Sheets("TABLE").Range("B6").FormulaR1C1 = "Scottage REDON"
Sheets("TABLE").Range("B7").FormulaR1C1 = "Multistore MUZIILAC"
Sheets("TABLE").Range("B8").FormulaR1C1 = "Multistore BLAIN"
Sheets("TABLE").Range("B9").FormulaR1C1 = "Poulain MUZILLAC"
Sheets("TABLE").Range("B10").FormulaR1C1 = "Esprit REDON"
Sheets("TABLE").Range("B11").FormulaR1C1 = "Esprit VANNES"
Sheets("TABLE").Range("B12").FormulaR1C1 = "Celio REDON"
Sheets("TABLE").Range("B13").FormulaR1C1 = "Celio REDON"
Sheets("TABLE").Range("B14").FormulaR1C1 = "Esprit LANGUEUX"
Sheets("TABLE").Range("B15").FormulaR1C1 = "Celio LANGUEUX"
Sheets("TABLE").Range("B16").FormulaR1C1 = "Multistore REDON"
Sheets("TABLE").Range("B17").FormulaR1C1 = "Berenger"

End If

Sheets("TABLE").Move Before:=Sheets(2)

End Sub

Sub Correspondance()

    Dim d As New Collection, n%, i%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d.Add .Cells(i, 2), CStr(.Cells(i, 1))
        Next i
    End With
    With Worksheets("CADOR")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            .Cells(i, 1) = d(CStr(.Cells(i, 1)))
        Next i
    End With

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Sheets("TABLE").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub SuppFeuilles()
'Supprimer toutes les feuilles sauf la première CADOR
If Sheets.Count = 1 Then Exit Sub
Dim tablo(), i
ReDim tablo(Sheets.Count - 2)
For i = 2 To ThisWorkbook.Sheets.Count
    tablo(i - 2) = Sheets(i).Name
Next
Application.DisplayAlerts = False
Sheets(tablo).Delete
End Sub

Bonjour,

Rapidement car pas le temps de tout lire...

Si on avait A=>B

Et tu as D=>C

Dans tous les Cells(ligne, colonne), tu remplaces le chiffre colonne :

Remplacer 1 par 4

Remplacer 2 par 3

Cordialement.

MFerrand a écrit :

Bonjour,

Rapidement car pas le temps de tout lire...

Si on avait A=>B

Et tu as D=>C

Dans tous les Cells(ligne, colonne), tu remplaces le chiffre colonne :

Remplacer 1 par 4

Remplacer 2 par 3

Cordialement.

Bonjour MFerrand,

Merci

Cordialement