Copie des certains elements
Bonjour,
Je voudrais faire une petite modification à ma macro.
En effet, je voudrais que si le numéro SIRET qui commence par un chiffre puisse copier que les 9 premiers chiffres dans la cellule à côté. (C’est ce que la macro peut faire actuellement).
Mais, en plus, je voudrais que si le SIRET commence par E, que la macro copie la cellule toute entière.
(voir fichier ci-joint)
Merci d’avance
Bonjour,
Il suffit d'ajouter une simple condition à ta macro :
Sub test()
Dim i As Integer, dl As Integer
dl = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To dl
If Left(Range("A" & i), 1) = "E" Then
Range("C" & i) = Range("A" & i)
Else
Range("C" & i) = Left(Range("A" & i), 9)
End If
Next i
End SubBonjour
Sub test()
Dim i As Integer, dl As Integer
dl = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To dl
If Range("A" & i) Like "E*" Then
Range("C" & i) = Range("A" & i)
Else
Range("C" & i) = Left(Range("A" & i), 9)
End If
Next i
End Suba+
Papou
Bonjour,
Merci beaucoup, mais j'aurai vraiment besoin d'une macro.
Merci d'avance
??? dans mon fichier joint, y'a bien une macro ! regarde le module de Feuil1 !
le code VBA est celui-ci :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim chn$, lng%
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 1 Then Exit Sub
If .Row = 1 Then Exit Sub
If Left$(.Value, 1) = "E" Then
chn = .Value
Else
lng = Len(.Value)
If lng >= 9 Then chn = Left$(.Value, 9)
End If
.Offset(, 2) = chn
End With
End Subdhany
Bonjour,
Je voudrais rajouter une exception, c'est lorsque le numéro SIRET commence par 0, donc dans ce cas il faudrait prendre en compte que les 9 premiers numéros et pas le 0. Ex:
Soit le 0789456123, cela devrait copier que 789456123.
Merci d'avance
Le code actuel est le suivant:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim chn$, lng%
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 1 Then Exit Sub
If .Row = 1 Then Exit Sub
If Left$(.Value, 1) = "E" Then
chn = .Value
Else
lng = Len(.Value)
If lng >= 9 Then chn = Left$(.Value, 9)
End If
.Offset(, 2) = chn
End With
End Sub
Bonjour José,
voici la nouvelle version :
merci de me donner ton avis.
dhany
Bonjour,
Merci beaucoup pour votre aide.
Serait-il possible de rajouter cette modif au fichier ci-joint? (dans l'excel que vous avez mis, je ne vois pas le code...)
Cordialement,
@jose1987
je te retourne ton fichier modifié :
le code VBA est ici :
ATTENTION !
* ce code VBA est une procédure événementielle : il ne doit pas être placé dans un module standard (tel que Module1)
* sur la feuille de calcul, j'ai mis tes 2 colonnes A et C en format Texte, avec un alignement à droite
dhany
Bonjour,
Je n'arrive pas à ouvrir le dialogue de macro dans votre fichier.
Pourriez-vous l'ajouter dans mon fichier ci-joint?
Merci d'avance
Merci d'avance
Bonjour;
Il doit y avoir un probleme car l'ensemble des fichiers que vous m'envoyez n'ont pas de code.
Pourriez-vous me le copier le code directement ici?
Merci d'avance
Bonjour,
Les fichiers envoyés sont au format ".xlsm", et je confirme que le code est bien présent. Où va tu chercher le code ? Je pense qu'il sera difficile de faire plus clair que les explications précédemment envoyées !
Bonjour,
@Pedro
merci pour ta confirmation que le code VBA est bien présent.
@José
voici le code VBA (que tu peux facilement copier/coller) :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim siret$, c1 As String * 1, chn$, lng%
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 1 Then Exit Sub
If .Row = 1 Then Exit Sub
siret = .Value: lng = Len(siret)
If lng > 0 Then
c1 = Left$(siret, 1)
If c1 = "E" Then
chn = siret
Else
If c1 = "0" Then
siret = Right$(siret, lng - 1): lng = lng - 1
End If
If lng >= 9 Then chn = Left$(siret, 9)
End If
End If
.Offset(, 2) = chn
End With
End Subdhany