Effacer les derniers caractères d'une cellule + recopier ligne dans onglet

[pierrof]

Bonjour

Je souhaite effacer les 2 derniers caractères des cellules de la colonne A, sachant que le nombre de ligne peut varié.

De plus j'aimerais recopier les lignes dans leurs onglet approprié.

Je joint un fichier exemple

Merci de vos explications et de votre aide

 

[youky(BJ)]

Re : Effacer les derniers caractères d'une cellule + recopier ligne dans onglet

Bonjour Pierrof,
Voici qui doit faire . . .
Bruno

Private Sub CommandButton1_Click()
For Each c In Range("A2:A" & [A1].End(xlDown).Row)
onglet = Left(c.Value, Len(c.Value) - 2)
lig = Sheets(onglet).[A65536].End(xlUp).Row + 1
On Error Resume Next
Sheets(onglet).Range("A" & lig & ":C" & lig).Value = _
Range("A" & c.Row & ":C" & c.Row).Value
If Err <> 0 Then MsgBox "erreur sur " & c.Value: Err.Clear
Next
End Sub

 

[kjin]

Re : Effacer les derniers caractères d'une cellule + recopier ligne dans onglet

Bonjour,
Pas trop compris mais bon

Private Sub CommandButton1_Click()
Dim nF As String, i As Integer, T As Variant
T = Range("A2:C" & Range("A65000").End(xlUp).Row).Value
For i = LBound(T) To UBound(T)
    On Error Resume Next
    nF = Left(T(i, 1), Len(T(i, 1)) - 2)
    With Sheets(nF)
        dl = .Range("A65000").End(xlUp).Row + 1
        .Cells(dl, 1) = "'" & nF
        .Cells(dl, 2) = T(i, 2)
        .Cells(dl, 3) = T(i, 3)
    End With
Next
End Sub

A+
kjin