Extraction et copie

[Aladin]

Bonjour le forum
J' ai une macro que j' essaye d' adapter pour une extraction et copie vers colonne se situant à gauche. Je m' explique, <extractionndes 4 derniers caractres de la colonne B qui sont des chiffres et les mettres dans la colonnes A. et aussi faire la mecro boucler sur certaines feuilles precises

Merci d' avance pour toute aide

Sub Toto()
[B3].Select 'On commence en B3
Do Until ActiveCell = "" 'Faire la boucle jusqu'à ce que la cellule selectionnée soit vide
ActiveCell.Offset(0, 2).FormulaR3A3 = "=RIGHT(RA[-4],2)"
'on se décale en C1 pour extraire les 2 caractéres
ActiveCell.Offset(1, 0).Select 'Décalage de 1 ligne à chaque fois
'on descend d'une cellule
Loop
[B3].Select
End Sub

Aladin

 

[Catrice]

Re : Extraction et copie

Bonjour,

A tester :

Sub Test1()
For Each X In Range("B3:" & Range("B65536").End(xlUp).Address)
X.Offset(0, 1) = Right(X, 4)
Next
End Sub

ou

Sub Test2()
For Each X In Range("B3:" & Range("B65536").End(xlUp).Address)
X.Offset(0, 1).FormulaR1C1 = "=Right(RC[-1],4)"
Next
End Sub

Voir le fichier joint

 

[Robert]

Re : Extraction et copie

Bonjour Aladin, bonjour le forum,

peut-être comme ça :

Sub Macro1()
Dim ong As Worksheet 'déclare la variable ong (ONGlet)
Dim cel As Range 'déclare la variable cel (CELlule)
 
For Each ong In Sheets 'boucle 1 : sur tous les onglets du classeur
    Select Case ong.Name 'action en fonction du nom de l'onglet
        Case "Feuil1", "Feuil3" 'à adapter (écrit ici la liste des onglets où tu veux que ça agisse séparés par une virgule)
        With ong 'prend en compte l'onglet
            For Each cel In .Range("B3:B" & .Range("B65536").End(xlUp).Row) 'boucle 2 : sur toutes les cellules éditées cel de la colonne B
                cel.Offset(0, -1).Value = Right(cel.Value, 4) 'place en colonne A les 4 derniers caractères de la cellule cel
            Next cel 'prochaine cellule cel de la boucle 2
        End With 'fin de la prise en compte de l'onglet
    End Select 'fin de l'action en fonction du nom de l'onglet
Next ong 'prochain onglet de la boucle 1
End Sub

Édition :

Bonjour Catrice on s'est croisé...

 

[Aladin]

Re : Extraction et copie

Bonsoir Catrice et le forum
Merci pour ta réponse c' est eexcellent et j' obtiens le résulatat voulu mais n' y a til pas moyen de le mettre l' extraction vers la colonne A
Aladin

 

[Robert]

Re : Extraction et copie

Bonjour Aladin, Catrice, bonjour le forum,

Regarde la solution que je te propose plus haut elle devrait te convenir.

 

[Aladin]

Re : Extraction et copie

Bonsoir Catrice, Robert et le forum
Mille excuse Robert je n' avais pas vu ta réponse, et c' est parfait et donne le resultat escopmté. Un grand merci à Catrice et à toi.
Aladin

 

[Catrice]

Re : Extraction et copie

Re,

Vers la colonne A

Sub Test1()
For Each X In Range("B3:" & Range("B65536").End(xlUp).Address)
X.Offset(0, -1) = Right(X, 4)
Next
End Sub

ou

Sub Test2()
For Each X In Range("B3:" & Range("B65536").End(xlUp).Address)
X.Offset(0, -1).FormulaR1C1 = "=Right(RC[1],4)"
Next
End Sub