Modification de code pour supprimer texte dans cellules

Bonsoir le forum

Voici un code qui permet de supprimer tout le texte dans une cellule active tout en laissant les chiffres

Comment modifier ce code pour qu'il boucle sur la colonne "A" par exemple

Sub essai()
Dim val1 As String
Dim i As Long
For i = 1 To Len(ActiveCell)
    If Asc(Mid(ActiveCell, i, 1)) > 47 And Asc(Mid(ActiveCell, i, 1)) < 59 Then val1 = val1 & Mid(ActiveCell, i, 1)
Next
ActiveCell = val1
End Sub

D'avance je vous remercie pour votre aide et votre disponibilité

Bonjour,

Comme cei :

Sub essai()

    Dim Plage As Range
    Dim Cel As Range
    Dim Val1 As String
    Dim I As Long

    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        For I = 1 To Len(Cel)

            If Asc(Mid(Cel.Value, I, 1)) > 47 And Asc(Mid(Cel.Value, I, 1)) < 59 Then Val1 = Val1 & Mid(Cel.Value, I, 1)

        Next I

        Cel.Value = Val1

    Next Cel

End Sub

Salut eole,

une façon de faire, entre toutes...

Sub essai()
'
Dim tTab
Dim val1 As String
Dim i As Integer
'
Application.EnableEvents = False
'
iRow = Cells(Rows.Count, 1).End(xlUp).Row
tTab = Range("A1:A" & iRow)
'
For x = 1 To UBound(tTab)
    val1 = ""
    For i = 1 To Len(tTab(x, 1))
        If Asc(Mid(tTab(x, 1), i, 1)) > 47 And Asc(Mid(tTab(x, 1), i, 1)) < 59 Then val1 = val1 & Mid(tTab(x, 1), i, 1)
    Next
    tTab(x, 1) = IIf(val1 <> "", val1, tTab(x, 1))
Next
Range("A1:A" & iRow) = tTab
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour le forum

Bonjour Theze et curulis57 merci pour votre disponibilité

Ok c'est super pour moi ça fonctionne

Merci beaucoup de votre aide