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

anouarlachiri

XLDnaute Junior
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 Junior
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 Junior
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 Junior
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 Junior
@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
 

Discussions similaires


Haut Bas