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

[Anr1]

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

 

[Lolote83]

Salut,
Voici un petit code qui devrait correspondre

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

 

[Anr1]

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]

Re salut,
Dans ce cas, on va déterminer la derniere ligne
Remplacer l'ancien code par celui-ci

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

 

[Anr1]

Re salut @Lolote83 ,

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 :

.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

 

[Lolote83]

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

On error resume next

Sous toute réserve
Voili voilà
@+ Lolote83

 

[Anr1]

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

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 !

 

[Anr1]

@Lolote83

Vous trouverez ci-joint un exemplaire de fichier avec le code VBA.

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

 

[Lolote83]

Salut,
Je regarde tout ceci demain.
@+ Lolote83

 

[Lolote83]

Re salut,
Avec ce nouveau code, cela devrait faire l'affaire

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

 

[Anr1]

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

@+