Mise en forme automatique Macro VBA

Bonjour à tous 👋,

Je travaille sur un script VBA qui vise à modifier la mise en forme d'un fichier brut (d'analyses) que je reçois d'un prestataire pour ensuite le mettre en forme de manière automatique dans un fichier excel avec ma mise en forme personnalisée.

J'ai mis le lien vers le fichier excel en question avec 3 onglets : 1er onglet la mise en forme voulue, 2ème et 3ème onglets : des exemples de fichier brut.

🧐 Problème rencontré :

Je ne suis pas sûr que cette approche soit optimisée ou qu’elle fonctionne parfaitement dans tous les cas (nombre d'échantillons analysés (colonnes) qui varie, composés analysés qui varient également (lignes)).

Est-ce que vous auriez des suggestions pour améliorer ce processus ou éviter d’éventuels bugs ? Notamment actuellement j'ai un bug sur la ligne "Columns(3).Insert Shift:=xlToRight".

Merci d’avance pour votre aide ! 🙏

Bonjour,

J'ai jeté un oeil sur ton fichier et le code que tu as construit (Module1) afin d'obtenir ce que tu aimmerais obtenir
J'ai quelques difficultés :

* avec quelle feuille travailles-tu "export" ou "Excel Summary" ? tu précises que ces deux feuilles sont des exemples de fichier brut. Selon ton code tu veux travailler avec la feuille export

    nbColumns = Sheets("export").Cells(6, Columns.Count).End(xlToLeft).Column - 10

* tu veux insérer de nouvelles colonnes si un nombre de colonnes - 10 sont utilisées, pourquoi -10 ? Donc ici tu vas recopier 29 fois la colonne "C"

* tu étudies le texte "l'échantillon" , soit S1 (0-0,3), soit S1 0-0,3, soit S1(0-0,3) alors que dans la feuille "export" ces noms sont du type Fxx (y-z), je ne comprends pas, et dans la feuille "Excel Summary" ils sont de la forme S1(x-y)

Bref j'ai du mal à comprendre et me trouve en difficulté pour pouvoir t'aider

Bonsoir,

Effectivement, ce n'est pas clair. De mon côté j'ai essayé d'améliorer votre code:

Option Explicit

Dim NbColumns As Long, i As Long, StartColumn As Long, EndColumn As Long, Col As Long
Dim Chaine As String, Montexte As String, Profondeur As String, MyData As String, Ligne As String
Dim Type_Format As Byte, Boucle As Byte
Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, f4 As Worksheet
Dim cell As Range
Dim Row_export As Object, Row_import As Object

Sub Export()
    Set f1 = Sheets("Table")
    Set f2 = Sheets("SOL")
    Set f3 = Sheets("export")
    Set f4 = Sheets("Excel Summary")
    StopActu

    'insert un nombre de colonne nécessaire avec la mise en page en fonction du nombre d'échantillon testé
    NbColumns = f3.Cells(6, Columns.Count).End(xlToLeft).Column - 10
    If NbColumns + 6 > 6 Then
        For i = 1 To NbColumns
            f2.Columns(2 + i).Copy
            f2.Columns(3).Insert Shift:=xlToRight
        Next
    End If

    Chaine = "Sous quel format se présente le nom de l'échantillon ?" + vbLf + "- S1 (0-0,3) : tapez 1" + vbLf + "- S1 0-0,3 : tapez 2" + vbLf + "- S1(0-0,3) : tapez 3"
    Type_Format = InputBox(Chaine, "Type de format")
        'copie/colle
    For i = 1 To NbColumns + 6
        If Type_Format = 1 Then
        'échantillon
            Montexte = f3.Cells(8, i + 4)
            f2.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
            f2.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
        'profondeur
            Profondeur = Left(Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " ")) + 1)), Len(Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " ")) + 1))) - 1)
            f2.Cells(3, i + 2) = Format(Profondeur, "@")
            f2.Cells(189, i + 2) = Format(Profondeur, "@")

        ElseIf Type_Format = 2 Then
        'échantillon
            Montexte = f3.Cells(8, i + 4)
            f2.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
            f2.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
        'profondeur
            Profondeur = Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " "))))
            f2.Cells(3, i + 2) = Format(Profondeur, "@")
            f2.Cells(189, i + 2) = Format(Profondeur, "@")

        ElseIf Type_Format = 3 Then
        'échantillon
            Montexte = f3.Cells(8, i + 4)
            f2.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, "(") - 1)
            f2.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, "(") - 1)
        'profondeur
            Profondeur = Left(Right(Montexte, Len(Montexte) - InStr(1, Montexte, "(")), Len(Right(Montexte, Len(Montexte) - InStr(1, Montexte, "("))) - 1)
            f2.Cells(3, i + 2) = Format(Profondeur, "@")
            f2.Cells(189, i + 2) = Format(Profondeur, "@")
        End If

        'date
        Montexte = f3.Cells(9, i + 4)
        f2.Cells(4, i + 2) = Montexte
        f2.Cells(190, i + 2) = Montexte
    Next

    'data
    For i = 1 To f1.Cells(Rows.Count, 1).End(xlUp).Row
        MyData = f1.Range("A" & i)
        Set Row_export = f3.Cells.Find(what:=MyData)
        If Not Row_export Is Nothing Then
            Set Row_export = f3.Cells.Find(MyData)
            Set Row_import = f2.Cells.Find(MyData)
            Row_export = Row_export.Row
            Row_import = Row_import.Row
            If f2.Cells(Row_import, 1) = f3.Cells(Row_export, 1) Then
                Col = f3.Cells(6, Columns.Count).End(xlToLeft).Column
                Range(f2.Cells(Row_import, 3), f2.Cells(Row_import, NbColumns + 6)).Value = Range(f3.Cells(Row_export, 5), f3.Cells(Row_export, Col)).Value
            End If
        End If
    Next

    ' Convertir les cellules insérées en nombres
    ConvertInsertedCellsToNumbers 3, 3 + NbColumns

    ' Convertir les valeurs de type "0 - 1000" en "<1000"
    ConvertRangeValues 3, 3 + NbColumns

    'Mise en forme éluats
    For i = 1 To NbColumns + 6
        For Boucle = 1 To 18
            Ligne = Choose(Boucle, "203", "204", "205", "208", "209", "210", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224")
            If InStr(1, f2.Cells(Ligne, i + 2), "-") = 3 Then
                Montexte = f2.Cells(Ligne, i + 2)
                f2.Cells(Ligne, i + 2) = "<" & Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, "-")) + 1))
            End If
        Next Boucle
    Next
    RestartActu
End Sub

Sub StopActu()
    ' suspend toutes les actualisations du classeur pour accélérer le code
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub

Sub RestartActu()
    ' reprend les actualisations du classeur
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Sub ConvertInsertedCellsToNumbers(StartColumn As Integer, EndColumn As Integer)
    For i = StartColumn To EndColumn
        For Each cell In f2.Columns(i).SpecialCells(xlCellTypeConstants, xlTextValues)
            If IsNumeric(cell.Value) Then
                cell.Value = cell.Value * 1
            End If
        Next cell
    Next i
End Sub

Sub ConvertRangeValues(StartColumn As Integer, EndColumn As Integer)
    For Col = StartColumn To EndColumn
        For Each cell In f2.Columns(Col).SpecialCells(xlCellTypeConstants, xlTextValues)
            If InStr(cell.Value, "0 - ") = 1 Then
                cell.Value = "<" & Trim(Mid(cell.Value, 5))
            End If
        Next cell
    Next Col
End Sub

Cdlt

Bonsoir Arturo,

Tu es allé plus loin que moi car à défaut de poser des questions tu as amélioré le code et c'est parfait car tu obtiens bien les éléments qui complètent la feuille "SOL"
Toutefois je reste sur mes incompréhensions en ce qui concerne les choix à faire consécutivement à

Chaine = "Sous quel format se présente le nom de l'échantillon ?" + vbLf + "- S1 (0-0,3) : tapez 1" + vbLf + "- S1 0-0,3 : tapez 2" + vbLf + "- S1(0-0,3) : tapez 3"
    Type_Format = InputBox(Chaine, "Type de format")

Serais-je passer à coté de quelques chose, en serait-il de même avec la feuille 'Table"

Set f1 = Sheets("Table")

que je ne trouve pas

J'en perds mon latin et cela m'inquiète

Au plaisir et bonne soirée

Bonjour Jacky,

Pour voir la feuille "Table", clic droit sur l'onglet d'une des feuilles, puis afficher.

Cdlt

Bonjour Arturo,

merci, en effet la feuille "Table" était cachée
Mais quant au choix dont je parlais, qu'en penses tu ?

Bonne journée

@ Jacky:

Mais quant au choix dont je parlais, qu'en penses tu ?

A vrai dire, je n'ai pas cherché à analyser en détail car le sujet est trop spécifique pour essayer de m'y intéresser plus en profondeur. Je n'ai pas eu cette volonté et me suis contenté d'apporter quelques modifications dans le code afin de l'optimiser, c'est ce qui était demandé.

Cdlt

très bien,
En ce qui me concerne c'est pareil, j'ai du mal à bien suivre l'idée qui est à la base de ce produit
En espérant que le demandeur pourra éventuellement me renseigner, j'abandonne également
Merci

Bonjour à vous et merci pour vos retours.

Désolé pour le temps de réponse.

1 /Je travaille avec la feuille "export" en effet le code fait appel à cette dernière et pas l'autre mais en soit c'est pour avoir 2 exemples brut à mettre en forme. L'objectif étant que ça fonctionne pour l'une comme pour l'autre (en renommant Excel Summary par export et en supprimant la première). Cela doit fonctionner avec les 2 feuilles bruts mais 1 à la fois (soit l'une soit l'autre). Actuellement, je reçois un excel s'appelant Excel Summary que je renomme export afin pour faire sa mise en forme. Là j'en ai mis 2 dans le même excel mais ils sont indépendants, je ne ferais appel qu'à 1 à la fois.

2/

 nbColumns = Sheets("export").Cells(6, Columns.Count).End(xlToLeft).Column - 10

* tu veux insérer de nouvelles colonnes si un nombre de colonnes - 10 sont utilisées, pourquoi -10 ? Donc ici tu vas recopier 29 fois la colonne "C"

Le but de cette ligne est de compter le nombre d'échantillon (chaque " S1(0-100)" correspond à 1 échantillon analysé) dans mon tableau brut et ensuite d'incrémenter mon tableau de mise en forme (onglet "SOL") afin d'avoir le bon nombre de colonne : 1 colonne/échantillon analysé. Typiquement dans l'onglet "export" il y a 8 échantillons donc dans l'onglet "SOL" il me faut 8 cases vides (il y en a déjà 6 de base).

3/

* tu étudies le texte "l'échantillon" , soit S1 (0-0,3), soit S1 0-0,3, soit S1(0-0,3) alors que dans la feuille "export" ces noms sont du type Fxx (y-z), je ne comprends pas, et dans la feuille "Excel Summary" ils sont de la forme S1(x-y)

En effet, la nomenclature des noms d'échantillons varient en fonction de l'utilisateur, pour palier à ça j'ai fait 3 alternatives de nomenclature mais ça ne couvre pas encore l'éventail des possibilités. Pour palier à ça, je fais une modification manuelle du fichier brut.

4/ J'ai pris le code d'Arturo : pas de bug si j'enlève la ligne : Set f4 = Sheets("Excel Summary")

Mais je n'arrive pas au résultat attendu.

Pour ça j'ai remis dans ce post un fichier excel avec 3 onglets : l'onglet 1 avec la mise en forme attendue mais vierge, l'onglet 2 avec les résultats analytiques bruts et l'onglet 3 avec la mise en forme finalisée des résultats analytiques présentés dans l'onglet 2.

Je reste disponible si vous avez plus de questions. Merci encore pour le temps consacré

merci Martin pour toutes les réponses que tu donnes à mes questions

comme tu reprends le code de Aturo, je te laisse le finaliser avec lui

Bon courag et au plaisir

Bonjour MartinBrk,

J'ai pris le code d'Arturo : pas de bug si j'enlève la ligne : Set f4 = Sheets("Excel Summary")

Mais je n'arrive pas au résultat attendu.

Le code que j'ai fourni n'est que le vôtre, mais allégé, il possible que dans la réorganisation ou le renommage des feuilles, je me sois fait des nœuds.

Vous pourriez dans un premier temps, essayer de par vous-même (car je pense vous connaissez bien votre fichier et ce que vous recherchez) de corriger cette erreur en exécutant le code en pas-à-pas avec F8, vous verrez bien alors, où se situe l'erreur.

Sinon, je ne pourrai regarder cela qu'épisodiquement dans la journée, car je ne suis pas toujours disponible.

Commencez par reprendre mon code et exécutez-le en pas-à-pas, vous aurez déjà bien avancé.

Cdlt

Bonjour,

Suite à vos indications, j'ai réussi à le faire fonctionner. Il reste néanmoins un petit détail que j'aimerais éclaircir notamment au niveau des mises en formes conditionnelles.

Ces dernières ne s'appliquent pas sur les 5 dernières colonnes (colonnes en rouge) peu importe le nombre de colonne ajouter par la macro, les 5 dernières n'ont jamais la mise en forme conditionnelle :

Pour information, la mise en forme conditionnelle est appliquée à toutes les colonnes initialement :

Cordialement

Bonjour,

Bravo si vous avez réussi à corrigé les bugs.

Pour les MFC, je peux y jeter un œil, mais il me faudrait le dernier fichier avec le code que vous avez modifié. De même un descriptif de ce que doivent faire les MFC serait le bienvenu.

Cdlt

Bonjour Arturo,

Voici la dernière version du fichier.

Pour les MFC : chaque teneur pour chaque échantillon est comparé individuellement à une valeur de comparaison.

1 / Si la cellule contient le symbole "<", il faut que ce soit en italique et grisé.

2 / Si la cellule contient une valeur supérieure aux valeurs de détection du laboratoire (donc non grisé/italique : point n°1), cette dernière est en gras et noire.

3/ Si la valeur dépasse la valeur haute des valeurs de comparaison (colonnes en orange), la cellule doit passée en rouge avec une écriture blanche en gras.

Exemple :

Ligne 7 : pas de symbole < donc aucune cellule avec le style n°1, et aucun dépassement de la valeur 284 (cf. colonne AL) donc l'ensemble doit être dans le style n°2.

Ligne 8 : style n°1 et la valeur de comparaison c'est 46,3 donc pas de style n°3 ni 2 car systématiquement le symbole "<".

Ligne 33 : nous avons les 3 styles car la limite de détection du laboratoire c'est 20 donc on a des valeur <20 donc style n°1, et on a aussi des valeurs > 500 donc style n°3. Avec les valeurs entre 20 et 500 qui doivent respecter le style n°2.

Comme expliqué dans le message précédent, seules les 5 dernières colonnes ne respectent pas la MFC, mais je ne sais pas pourquoi... Peut-être ajouter 5 colonnes puis comme ça je supprime manuellement les 5 dernières qui plantent ?

A+

Bonjour,

Comme expliqué dans le message précédent, seules les 5 dernières colonnes ne respectent pas la MFC, mais je ne sais pas pourquoi.

C'est la façon d'utiliser le nombre de colonnes qui n'est pas bon, et donc, votre code s'arrête quelques colonnes avant la dernière, votre problème vient de là.

code modifié:

Sub Export()
    StopActu

    'insert un nombre de colonne nécessaire avec la mise en page en fonction du nombre d'échantillon testé
    NbColumns = Sheets("export").Cells(6, Columns.Count).End(xlToLeft).Column - 4
    If NbColumns > 6 Then
        For i = 1 To NbColumns - 8
             Sheets("SOL").Columns(4).Insert Shift:=xlToRight
        Next
    End If

    chaine = "Sous quel format se présente le nom de l'échantillon ?" + vbLf + "- S1 (0-0,3) : tapez 1" + vbLf + "- S1 0-0,3 : tapez 2" + vbLf + "- S1(0-0,3) : tapez 3"
    type_format = InputBox(chaine, "Type de format")
        'copie/colle
    For i = 1 To NbColumns
        If type_format = 1 Then
        'échantillon
            Montexte = Sheets("export").Cells(8, i + 4)
            ActiveSheet.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
            ActiveSheet.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
        'profondeur
            profondeur = Left(Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " ")) + 1)), Len(Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " ")) + 1))) - 1)
            ActiveSheet.Cells(3, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(3, i + 2) = profondeur
            ActiveSheet.Cells(189, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(189, i + 2) = profondeur

        ElseIf type_format = 2 Then
        'échantillon
            Montexte = Sheets("export").Cells(8, i + 4)
            ActiveSheet.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
            ActiveSheet.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
        'profondeur
            profondeur = Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " "))))
            ActiveSheet.Cells(3, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(3, i + 2) = profondeur
            ActiveSheet.Cells(189, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(189, i + 2) = profondeur

        ElseIf type_format = 3 Then
        'échantillon
            Montexte = Sheets("export").Cells(8, i + 4)
            ActiveSheet.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, "(") - 1)
            ActiveSheet.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, "(") - 1)
        'profondeur
            profondeur = Left(Right(Montexte, Len(Montexte) - InStr(1, Montexte, "(")), Len(Right(Montexte, Len(Montexte) - InStr(1, Montexte, "("))) - 1)
            ActiveSheet.Cells(3, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(3, i + 2) = profondeur
            ActiveSheet.Cells(189, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(189, i + 2) = profondeur
        End If

        'date
        Montexte = Sheets("export").Cells(9, i + 4)
        ActiveSheet.Cells(4, i + 2) = Montexte
        ActiveSheet.Cells(190, i + 2) = Montexte
    Next
    'data
    For i = 1 To Sheets("Table").Cells(Rows.Count, 1).End(xlUp).Row
        mydata = Sheets("Table").Range("A" & i)
        Set Row_export = Sheets("export").Cells.Find(what:=mydata)
        If Not Row_export Is Nothing Then
            Set Row_export = Sheets("export").Cells.Find(what:=mydata)
            Set Row_import = ActiveSheet.Cells.Find(what:=mydata)
            Row_export = Row_export.Row
            Row_import = Row_import.Row
            If ActiveSheet.Cells(Row_import, 1) = Sheets("export").Cells(Row_export, 1) Then
                col = Sheets("export").Cells(6, Columns.Count).End(xlToLeft).Column
                Sheets("export").Select
                Sheets("export").Range(Cells(Row_export, 5), Cells(Row_export, col)).Copy
                Sheets("SOL").Select
                ActiveSheet.Range(Cells(Row_import, 3), Cells(Row_import, NbColumns + 6)).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next

       ' Convertir les cellules insérées en nombres
    ConvertInsertedCellsToNumbers 3, 3 + NbColumns

        ' Convertir les valeurs de type "0 - 1000" en "<1000"
    ConvertRangeValues 3, 3 + NbColumns

    'Mise en forme éluats
    For i = 1 To NbColumns + 6
        For boucle = 1 To 18
            ligne = Choose(boucle, "203", "204", "205", "208", "209", "210", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224")
            If InStr(1, ActiveSheet.Cells(ligne, i + 2), "-") = 3 Then
                Montexte = ActiveSheet.Cells(ligne, i + 2)
                ActiveSheet.Cells(ligne, i + 2) = "<" & Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, "-")) + 1))
            End If
        Next boucle
    Next
    RestartActu
End Sub

Sub StopActu()
    ' suspend toutes les actualisations du classeur pour accélérer le code
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub

Sub RestartActu()
    ' reprend les actualisations du classeur
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Sub ConvertInsertedCellsToNumbers(startColumn As Integer, endColumn As Integer)
    Dim cell As Range
    Dim i As Integer
    For i = startColumn To endColumn
        For Each cell In Columns(i).SpecialCells(xlCellTypeConstants, xlTextValues)
            If IsNumeric(cell.Value) Then
                cell.Value = cell.Value * 1
            End If
        Next cell
    Next i
End Sub

Sub ConvertRangeValues(startColumn As Integer, endColumn As Integer)
    Dim cell As Range
    Dim col As Integer
    For col = startColumn To endColumn
        For Each cell In Columns(col).SpecialCells(xlCellTypeConstants, xlTextValues)
            If InStr(cell.Value, "0 - ") = 1 Then
                cell.Value = "<" & Trim(Mid(cell.Value, 5))
            End If
        Next cell
    Next col
End Sub

Cdlt

Bonjour,

Ok cela fonctionne merci beaucoup !

Dernière chose, il y a un problème au niveau du nombre de colonne, il en manque une maintenant (AH) :

Voici le corrigé:

Sub Export()
    StopActu

    'insert un nombre de colonne nécessaire avec la mise en page en fonction du nombre d'échantillon testé
    NbColumns = Sheets("export").Cells(6, Columns.Count).End(xlToLeft).Column - 4
    If NbColumns > 6 Then
        For i = 1 To NbColumns - 6
             Sheets("SOL").Columns(4).Insert Shift:=xlToRight
        Next
    End If

    chaine = "Sous quel format se présente le nom de l'échantillon ?" + vbLf + "- S1 (0-0,3) : tapez 1" + vbLf + "- S1 0-0,3 : tapez 2" + vbLf + "- S1(0-0,3) : tapez 3"
    type_format = InputBox(chaine, "Type de format")
        'copie/colle
    For i = 1 To NbColumns
        If type_format = 1 Then
        'échantillon
            Montexte = Sheets("export").Cells(8, i + 4)
            ActiveSheet.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
            ActiveSheet.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
        'profondeur
            profondeur = Left(Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " ")) + 1)), Len(Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " ")) + 1))) - 1)
            ActiveSheet.Cells(3, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(3, i + 2) = profondeur
            ActiveSheet.Cells(189, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(189, i + 2) = profondeur

        ElseIf type_format = 2 Then
        'échantillon
            Montexte = Sheets("export").Cells(8, i + 4)
            ActiveSheet.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
            ActiveSheet.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, " ") - 1)
        'profondeur
            profondeur = Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, " "))))
            ActiveSheet.Cells(3, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(3, i + 2) = profondeur
            ActiveSheet.Cells(189, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(189, i + 2) = profondeur

        ElseIf type_format = 3 Then
        'échantillon
            Montexte = Sheets("export").Cells(8, i + 4)
            ActiveSheet.Cells(2, i + 2) = Left(Montexte, InStr(1, Montexte, "(") - 1)
            ActiveSheet.Cells(188, i + 2) = Left(Montexte, InStr(1, Montexte, "(") - 1)
        'profondeur
            profondeur = Left(Right(Montexte, Len(Montexte) - InStr(1, Montexte, "(")), Len(Right(Montexte, Len(Montexte) - InStr(1, Montexte, "("))) - 1)
            ActiveSheet.Cells(3, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(3, i + 2) = profondeur
            ActiveSheet.Cells(189, i + 2).NumberFormat = "@"
            ActiveSheet.Cells(189, i + 2) = profondeur
        End If

        'date
        Montexte = Sheets("export").Cells(9, i + 4)
        ActiveSheet.Cells(4, i + 2) = Montexte
        ActiveSheet.Cells(190, i + 2) = Montexte
    Next
    'data
    For i = 1 To Sheets("Table").Cells(Rows.Count, 1).End(xlUp).Row
        mydata = Sheets("Table").Range("A" & i)
        Set Row_export = Sheets("export").Cells.Find(what:=mydata)
        If Not Row_export Is Nothing Then
            Set Row_export = Sheets("export").Cells.Find(what:=mydata)
            Set Row_import = ActiveSheet.Cells.Find(what:=mydata)
            Row_export = Row_export.Row
            Row_import = Row_import.Row
            If ActiveSheet.Cells(Row_import, 1) = Sheets("export").Cells(Row_export, 1) Then
                col = Sheets("export").Cells(6, Columns.Count).End(xlToLeft).Column
                Sheets("export").Select
                Sheets("export").Range(Cells(Row_export, 5), Cells(Row_export, col)).Copy
                Sheets("SOL").Select
                ActiveSheet.Range(Cells(Row_import, 3), Cells(Row_import, NbColumns + 6)).PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next

       ' Convertir les cellules insérées en nombres
    ConvertInsertedCellsToNumbers 3, 3 + NbColumns

        ' Convertir les valeurs de type "0 - 1000" en "<1000"
    ConvertRangeValues 3, 3 + NbColumns

    'Mise en forme éluats
    For i = 1 To NbColumns + 6
        For boucle = 1 To 18
            ligne = Choose(boucle, "203", "204", "205", "208", "209", "210", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224")
            If InStr(1, ActiveSheet.Cells(ligne, i + 2), "-") = 3 Then
                Montexte = ActiveSheet.Cells(ligne, i + 2)
                ActiveSheet.Cells(ligne, i + 2) = "<" & Right(Montexte, Len(Montexte) - ((InStr(1, Montexte, "-")) + 1))
            End If
        Next boucle
    Next
    RestartActu
End Sub

Sub StopActu()
    ' suspend toutes les actualisations du classeur pour accélérer le code
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub

Sub RestartActu()
    ' reprend les actualisations du classeur
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Sub ConvertInsertedCellsToNumbers(startColumn As Integer, endColumn As Integer)
    Dim cell As Range
    Dim i As Integer
    For i = startColumn To endColumn
        For Each cell In Columns(i).SpecialCells(xlCellTypeConstants, xlTextValues)
            If IsNumeric(cell.Value) Then
                cell.Value = cell.Value * 1
            End If
        Next cell
    Next i
End Sub

Sub ConvertRangeValues(startColumn As Integer, endColumn As Integer)
    Dim cell As Range
    Dim col As Integer
    For col = startColumn To endColumn
        For Each cell In Columns(col).SpecialCells(xlCellTypeConstants, xlTextValues)
            If InStr(cell.Value, "0 - ") = 1 Then
                cell.Value = "<" & Trim(Mid(cell.Value, 5))
            End If
        Next cell
    Next col
End Sub

Une petite équipe et moi-même vous remercie pour votre aide et le temps futur gagné !