Copier portion de cellule d'une colonne dans une autre

Bonjour!

Je me casse la tête sur mon fichier, quelqu'un aurait un bout de code VBA pour réaliser la fonction suivante?

J'aimerai insérer une colonne avant la colonne intitulé "Alt. ID poste techn." (Les titres de colonnes sont toujours dans la ligne 7) et la nommer "Unité"

J'aimerai ensuite coller une partie de la chaine de caractère de la colonne "Alt. ID poste techn." dans la nouvelle colonne "Unité".

Le début de la chaine est toujours le même, il faudrait juste copier les 6 caractères après les 8 premiers caractères et supprimer les espaces inutiles.

Le nombre de lignes est indéfini

Exemple: 1/FR007-O4 -T-60-T6108V ==> O4

Un grand merci à ceux qui me donnerons un peu de leur temps!

Bryan

Bonjour,

Sub Test()
Dim C As Range
Dim i As Long
    With Worksheets("Feuil1")
        Application.ScreenUpdating = False
        Set C = .Cells.Find("Alt. ID poste techn.", LookIn:=xlValues, lookat:=xlPart)
        If Not C Is Nothing Then
            C.EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            C.Offset(0, -1) = "Unité"
            For i = C.Offset(1, 0).Row To C.End(xlDown).Row
                .Cells(i, C.Column - 1) = Mid(.Cells(i, C.Column), 9, 6)
            Next i
        End If
        Set C = Nothing
    End With
End Sub

A+

salut,

moi je fais ça !!!

Sub test()

Rows(7).Find(What:="Alt. ID poste techn.", LookAt:=xlPart).Select
ActiveCell.EntireColumn.Insert
ActiveCell = "Unité"

Range("F8", Range("F8").End(xlDown)).Select

For Each a In Range(Cells(8, ActiveCell.Column + 1), Cells(8, ActiveCell.Column + 1).End(xlDown))
    a.Offset(0, -1).Value = Right(Left(a.Value, 10), 2)
Next

End Sub

Bonjour

Je me suis endormi

A tester

Trop fort les gars! Merci!