XL 2013 enlever (N°) dans une colonne des données ( VBA ) automatique

anouarlachiri

XLDnaute Occasionnel
Bonjour ,

Je cherche un programme VBA qui permet de coller la colonne "A" Feuil1 dans la colonne "B" Feuil2 mais dans (n°)

Exemple :
en colonne A on trouve : n°55555555E

je veux qu'on colonne B Feuile2 : 55555555E (sans n°)

vous trouverez ci-jointe le fichier
 

Fichiers joints

Lolote83

XLDnaute Accro
Salut,
Voici un petit code qui devrait correspondre
VB:
Sub Test()
    With Sheets("Feuil1")
        For Each xCell In .Range("A2:A5")                   'On parcours les cellules de la feuille1 de A2 à A5
            If xCell.Value <> "" Then                       'Si cellule <> vide
                xDecoupe = Split(xCell.Value, "n°")         'On découpe en fonction des caractères n°
                xCpt = xCpt + 1                             'On incrémente un compteur
                With Sheets("Feuil2")                       'On travaille maintenant sur feuille2
                    .Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
                End With
            End If
        Next xCell                                          'Fin boucle
    End With
End Sub
@+ Lolote83
 

anouarlachiri

XLDnaute Occasionnel
Merci bien pour ta réactivité :) ,
votre programme marche parfaitement sur le fichier jointe par contre ca marche pas sur mon fichier !

La différence :

- Mon fichier ne termine pas en A5 ( j'aimerai que ca soit relatif ) c'est à dire tte la colonne

Lorsque je change:
Each xCell In .Range("A2:A5")
par

Each xCell In .Range("A2:A") ( tt la colonne A ) ne marche plus !
 

Lolote83

XLDnaute Accro
Re salut,
Dans ce cas, on va déterminer la derniere ligne
Remplacer l'ancien code par celui-ci
VB:
Sub Test()
    With Sheets("Feuil1")
        xDerLig = .Range("A50000").End(xlUp).Row            'On détermine la dernière ligne
        For Each xCell In .Range("A2:A" & xDerLig)          'On parcours les cellules de la feuille1 de A2 à dernière ligne
            If xCell.Value <> "" Then                       'Si cellule <> vide
                xDecoupe = Split(xCell.Value, "n°")         'On découpe en fonction des caractères n°
                xCpt = xCpt + 1                             'On incrémente un compteur
                With Sheets("Feuil2")                       'On travaille maintenant sur feuille2
                    .Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
                End With
            End If
        Next xCell                                          'Fin boucle
    End With
End Sub
@+ Lolote83
 

anouarlachiri

XLDnaute Occasionnel
Re salut @Lolote83 ,

VB:
Sub Test()

Dim xDerlig As Integer
Dim xCell As Variant
Dim xDecoupe As Variant
Dim xCpt As Variant

    With Sheets("xxxxx")
    xDerlig = .Range("G1048576").End(xlUp).Row
        For Each xCell In .Range("G2:G" & xDerlig)                   'On parcours les cellules de la feuille1 de A2 à A5
            If xCell.Value <> "" Then                       'Si cellule <> vide
                xDecoupe = Split(xCell.Value, "n°")         'On découpe en fonction des caractères n°
                xCpt = xCpt + 1                             'On incrémente un compteur
                With Sheets("yyyyyyy")                       'On travaille maintenant sur feuille2
                    .Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
                End With
            End If
        Next xCell                                          'Fin boucle
    End With
End Sub

voilà le code a bien marcher après que j'ai défini les variables , par contre y'a un message " erreur d'exécution '9'" ( l'indice n'appartient pas à la sélection.

et lorsque je clic qur débogage la ligne :

Code:
.Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
s'affiche en jaune !

si vous pouvez m'expliquer pourquoi ou bien si vous avez une solution !

merci bien
 
Dernière édition:

Lolote83

XLDnaute Accro
Re salut,
Sans fichier joint, difficile de dire mais :
L'erreur déterminée est dûe au fait que sur 1 ou plusieurs (mais en tout cas dès la première) cellules le type n'est pas défini comme indiqué a savoir n°123456789....
De fait la partie "découpe" ne peut pas traiter si cellule différente d'ou l'erreur
On peut tout de même zappé en inscrivant en début de code
VB:
On error resume next
Sous toute réserve
Voili voilà
@+ Lolote83
 

anouarlachiri

XLDnaute Occasionnel
Merci pour votre réponse @Lolote83 :)

cette fois ci j'aimerais savoir si on peut sauter les cellules vides est pas les supprimer j'ai essayer ce programme mais ne fonctionne pas
VB:
Sub Test()

Dim xDerlig As Integer
Dim xCell As Variant
Dim xDecoupe As Variant
Dim xCpt As Variant


    With Sheets("xxxxxxx")
    xDerlig = .Range("G1048576").End(xlUp).Row
        For Each xCell In .Range("G2:G" & xDerlig)                   'On parcours les cellules de la feuille1 de A2 à A5
            If xCell.Value <> "" Then                       'Si cellule <> vide
                xDecoupe = Split(xCell.Value, "n°")         'On découpe en fonction des caractères n°
                xCpt = xCpt + 1
                Else
                xCell.Value = ""
                xDecoupe = ""
                xCpt = xCpt + 1
                
                                                                'On incrémente un compteur
                With Sheets("xxxxx")                       'On travaille maintenant sur feuille2
                    .Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
                  
                End With
            
              
            End If
        
          
        Next xCell
                           'Fin boucle
    End With
  
  
End Sub

J'ai ajouté" Else" mais j'ai mis une erreure quelque part !
 
Dernière édition:

anouarlachiri

XLDnaute Occasionnel
@Lolote83

Vous trouverez ci-joint un exemplaire de fichier avec le code VBA.
VB:
Sub Test()

Dim xDerlig As Integer
Dim xCell As Variant
Dim xDecoupe As Variant
Dim xCpt As Variant

    With Sheets("Feuil2")
    xDerlig = .Range("G1048576").End(xlUp).Row
        For Each xCell In .Range("G2:G" & xDerlig)                   'On parcours les cellules de la feuille1 de A2 à A5
            If xCell.Value <> "" Then                       'Si cellule <> vide
                xDecoupe = Split(xCell.Value, "n°")         'On découpe en fonction des caractères n°
                xCpt = xCpt + 1
                                                       'On incrémente un compteur
                 With Sheets("Feuil1")                       'On travaille maintenant sur feuille2
                    .Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
                    
                End With
              
                
            End If
          
            
        Next xCell
                           'Fin boucle
    End With
    
    
End Sub
Merci d'avance ;)
 

Fichiers joints

Dernière édition:

Lolote83

XLDnaute Accro
Re salut,
Avec ce nouveau code, cela devrait faire l'affaire
VB:
Sub Test()
    Dim xDerlig As Integer
    Dim xCell As Variant
    Dim xDecoupe As Variant
    Dim xCpt As Variant
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    With Sheets("Feuil2")                                   'On travaille sur feuille2
        xDerlig = .Range("G1048576").End(xlUp).Row          'On détermine la dernière ligne
        For Each xCell In .Range("G2:G" & xDerlig)          'On parcours les cellules de la feuille1 de G2 à dernière ligne
            xCpt = xCpt + 1                                 'On incrémente un compteur
            If xCell.Value <> "" Then                       'Si cellule <> vide
                xDecoupe = Split(xCell.Value, "n°")         'On découpe en fonction des caractères n°
                With Sheets("Feuil1")                       'On travaille maintenant sur feuille1
                    .Range("B" & 1 + xCpt) = xDecoupe(1)    'On inscrit en colonne B
                End With
            End If
        Next xCell
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
@+ Lolote83
 

anouarlachiri

XLDnaute Occasionnel
Bonjour @Lolote83 ,

Merci bien pour votre aide :)
oui je pense que çà fonctionne je revient vers vous dès que j'essaye le programme.

Je vous remercie une autre fois ;)

@+
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas