Problème VBA Excel 2019

Bonjour , Merci d'avance pour votre aide!

J'essaye de réaliser un programme en VBA mais je n'y arrive pas .

Mon problème est le suivant :

J'ai la colonne J qui contient une informations de type "lieux d'achat" + "numéro de commande " : par exemple : Paris6416854

J'aimerais que mon programme vba divise cette information en deux colonnes distinctes, l'une avec le nom de la ville et l'autre avec le numéro de commande. Le problème que je rencontre c'est que me boucle ne s'arrête jamais et fait planter mon fichier excel.

Voici le code après beaucoup de test et changements, mais impossible de le faire fonctionner

With Sheets(1)
i = 2
    Do While Cells(i, 3) <> ""
    ActiveCell.Offset(0, 0).FormulaR1C1 = _
    Left$(i, 4)
    ActiveCell.Offset(1, 0).Select
    i = i + 1
    Loop

Merci encore pour votre aide ,

Je suis obligé de passer en vba , car le fichier est généré en vba

Bien cordialement,

Bonjour Spiye01 et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment :

1. Rédigez soigneusement votre demande et choisissez un titre qui résume bien votre demande.

Vous pourrez regarder également les fonctionnalités (Nouveau Forum au bas de page notamment)

Merci de votre participation

Cordialement

Bonjour,

Sans données confidentielles...

Cordialement

edit : oups Bruno... pas vu ton post !

colonne J qui contient une informations de type "lieux d'achat" + "numéro de commande "...
J'aimerais que mon programme vba divise cette information en deux colonnes distinctes,

Quelles colonnes ?
Là vous bouclez sur la colonne 3.

Merci , je m'en vais de ce pas me présenter. J'ai fais un nouveau fichier a la va vite pour vous montrer l'objectif que je souhaite atteindre. J'ai juste inscrit trois valeurs mais il faut imaginer une base de donnée avec plus de 100 valeurs. Voila je souhaite diviser la colonne code en deux nouvelles colonnes. La première colonne reprend la ville et la seconde le numéro de commande. Je verrais bien un programme de ce type:

- Tant que la valeurs de la cellule code n'est pas vide, prendre la valeur texte

Copier la valeur texte dans une nouvelle colonne

Puis prendre la valeur numérique

Copier cette valeur en face du texte correspondant

Et lorsque toutes les données sont divisés, supprimer la colonne avec les codes.

Salut Dan ;-)

@Spiye01, c'est clair, c'est toujours mieux de joindre un fichier
Malgré tout, d'après ce que j'ai compris, voici un code qui fonctionne à vous de l'adapter au cas ou

Sub SéparationEn2Colonnes()
  Dim dLig As Long, Lig As Long
  Dim Ind As Long, Tablo As Variant, Tabd() As String
  Dim PosNum As Integer, sTmp As String
  With Sheets(1)
    dLig = .Range("J" & Rows.Count).End(xlUp).Row
    Tablo = Application.Transpose(.Range("J2:J" & dLig).Value)
    For Ind = 1 To UBound(Tablo)
      For PosNum = 1 To Len(Tablo(Ind))
        If IsNumeric(Mid(Tablo(Ind), PosNum, 1)) Then
          ReDim Preserve Tabd(2, Ind)
          Tabd(0, Ind) = Left(Tablo(Ind), PosNum - 1)
          Tabd(1, Ind) = Mid(Tablo(Ind), PosNum)
          Exit For
        End If
      Next PosNum
    Next Ind
    .Range("C1:D" & dLig).Value = Application.Transpose(Tabd)
  End With
End Sub

Nota : j'ai pris en compte que la ville peut être différente

A+

Edit : pas vu votre dernier post, ce ne sont plus les mêmes colonnes

Merci énormément pour ton aide. L'importance et que je puisse comprendre le code pour le remettre a ma sauce. En tout cas je vais tester ça :)

Encore merci

A+

Re,

J'essaie toujours de faire des codes assez simple avec des variables pour la compréhension

Bonjour,

Bonjour Bruno :)

Une autre solution, en utilisant RegExp...

Sub ville_cde()
Dim Plg As Range, Cel As Range
Dim Commande As Object, Ville As Object
Set Commande = CreateObject("vbscript.regexp")
Set Ville = CreateObject("vbscript.regexp")
Commande.pattern = "[\d]+": Ville.pattern = "[^\d ]+"
With Sheets("Feuil1")
    Set Plg = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
    For Each Cel In Plg
        If Cel <> "" Then
            Set a = Ville.Execute(Cel.Value)
            Set b = Commande.Execute(Cel.Value)
                If a.Count > 0 Then Cel.Offset(, 7) = a(0)
                If b.Count > 0 Then Cel.Offset(, 8) = CLng(b(0))
        End If
    Next Cel
End With
End Sub

Et le fichier exemple :

Ca marche au TOP !!! Mille merci :)