Mettre les unité directement dans les en-tête de tableau

Bonjour,

Je viens de découvrir le VBA et donc les macros.

Mon soucis dans mon fichier est que je voudrais que lorsqu'il y a des unité (m, h , Kg etc ) dans des cases de tableau, celle-ci s'enlève des cases du tableau et vienne automatiquement sur l'en-tête. (voir fichier ci-joint)

Bien cordialement,

Merci d'avance

Hello,

essaye ca :

Sub TEST()
Dim TITRE As String
Dim derniereLigne, derniereColonne, i, j, k As Integer

derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
derniereColonne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
For k = 1 To derniereColonne

    TITRE = Cells(1, k)
    Cells(1, k) = TITRE & " (en " & Mid(Cells(2, k).Value, 2) & ")"

        For i = 2 To derniereLigne

             texte = Cells(i, k).Value
                    L = Len(texte)
                    For j = L To 1 Step -1
                        If Mid(texte, j, 1) = Chr(32) Then
                            m = j
                            Exit For
                        End If
                    Next j

                    Cells(i, k).Value = Trim(Mid(texte, n + 1, m - n - 1))

        Next i

Next k

End Sub

Bonjour merci pour ta réponse le programme marche super bien le seul soucis est que les chiffres a virgule reste en format texte et non en nombre.

Merci d'avance

ne fonctionne que si ce sont des nombres après la suppression des unités

Sub TEST()
Dim TITRE As String
Dim derniereLigne, derniereColonne, i, j, k As Integer

derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
derniereColonne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
For k = 1 To derniereColonne

    TITRE = Cells(1, k)
    Cells(1, k) = TITRE & " (en " & Mid(Cells(2, k).Value, 2) & ")"

        For i = 2 To derniereLigne

             texte = Cells(i, k).Value
                    L = Len(texte)
                    For j = L To 1 Step -1
                        If Mid(texte, j, 1) = Chr(32) Then
                            m = j
                            Exit For
                        End If
                    Next j

                    Cells(i, k).Value = Trim(Mid(texte, n + 1, m - n - 1))
                    Cells(i, k).Value = Cells(i, k).Value * 1

        Next i

Next k

End Sub

ne fonctionne pas dans ton exemple car tu as une cellule avec écrit "etc..."

Très bien je vais essayer de m'inspirer du programme merci encore !!!

Bien cordialement