Transfert et conversion des données

Bonjour,

Je veux réaliser une macro qui me permette d'aller chercher des informations dans un onglet "liste" pour l'envoyer dans l'onglet "mélange".

Les données à aller chercher sont bien sûr soumises à des conditions (sinon c'est moins drôle ).

Et en plus de ça, je veux convertir certaines des données de l'onglet liste.

Donc j'ai écrit ce premier code, pour lequel j'utilise une "zone tampon" dans laquelle je stocke les données de l'onglet "liste" avant de les incrémenter dans l'onglet "mélange".

Remarque : dans les deux cas j'utilise une zone "modèle" : "A6:BC9"

Sub incrémentation()

    Worksheets("Mélange").Activate

    Dim cell As Range
    For Each cell In Worksheets("Liste").Range("F4", Worksheets("Liste").Range("F4").End(xlDown)) 

    Range("B2:BB2").ClearContents 'zone "tampon"

        If cell.Value <> ""
            Dim mélange
            Dim déno_mélange
            mélange = cell.Value
            déno_mélange= Range(cell.Offset(0, -5), cell.Offset(0, -4)).Value

                Range("B2:C2").Value = déno_mélange
                Range("D2").Value = mélange

                    Range("D2").TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
                    ConsecutiveDelimiter:=True, Semicolon:=True, Space:=True

            Range("A6:BC9").copy

            Range("A10").Select
                Do Until IsEmpty(ActiveCell) = True
                    ActiveCell.Offset(1, 0).Activate 
                Loop
                    ActiveSheet.Paste 

                        Dim code
                        Dim nom
                        Dim mix
                        code = Range("B2").Value
                        nom = Range("C2").Value
                        mix = Range("E2:BB2").Value

                        ActiveCell.Value = code
                        ActiveCell.Offset(0, 1).Value = nom
                        Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(0, 54)).Value = mix                
        End If
    Next cell

End Sub

Malheuresement ce code est extrêmement long à exécuter. J'ai supposé que c'était à cause des copier/coller. Donc j'ai essayé cette deuxième version :

Sub incrémentation2()

Dim C1 As Range
For Each C1 In Worksheets("Liste").Range("F4", Worksheets("Liste").Range("F4").End(xlDown))

    If C1.Value <> "" Then

        Worksheets("mélange").Range("A65536").End(xlUp).Offset(1, 0).Activate
        Range("A6:BC9").copy
        ActiveSheet.Paste

        Dim code
        Dim nom
        code = C1.Offset(0, -5).Value
        nom = C1.Offset(0, -4).Value

        ActiveCell.Value = code
        ActiveCell.Offset(0, 1) = nom

        C1.TextToColumns Destination:=(Worksheets("mélange").Range("A65536").End(xlUp).Offset(0, 5)), DataType:=xlDelimited, _
        ConsecutiveDelimiter:=True, Semicolon:=True, Space:=True
    End If
Next C1
End Sub

Dans ce cas là, le code ne fonctionne pas du tout...

Il faut que je fasse un tri avant de démarrer la macro dans l'onglet "liste" sur le colonne F pour ne garder que les cellule remplies sinon ça ne fonctionne pas. (il n'y a même pas de message d'erreur mais ça ne fonctionne pas...)

Mon code pour convertir n'a pas l'air de fonctionner lui non plus...

Est ce que quelqu'un a une idée de ce qu'il se passe pour que rien ne bouge sauf si je fais un tri sur la colonne F ?

Et si quelqu'un à une meilleure idée pour améliorer la vitesse du premier code je suis preneur

Merci !!

bonjour

c'est une recette cuisine ou chimie

es-tu certain qu'il faut une macro ?

en général on fait ça avec des RECHERCHEV

Bonjour

En fournissant un fichier tu auras plus de chance d'avoir une solution à ton problème

Indique ce que tu as et quel résultat tu veux obtenir

Bonjour,

Non une RECHERCHEV ne suffirait pas. J'ai un grand nombre de données à ajouter, et je n'ai pas le courage d'insérer les codes manuellement. Et avec mes (maigres) connaissances en excel, si j'utilise une RECHERCHEV je suis obligé de rentré les codes pour avoir les autres informations.

En plus, j'ai besoin de convertir les données donc définitivement je ne pense pas que ce soit la solution. Mais je me trompe peut être!!

Pour ce qui est du fichier le mien est très lourd, j'essaye d'en créer une version simplifiée à vous envoyer.

Voilà le fichier joint.

L'objectif est donc de déplacer les données des colonnes A, B et F de l'onglet Liste vers l'onglet Mélange. Seules les données qui contiennent des informations dans la colonne F sont à déplacer.

Les données de la colonnes F doivent être converties pour être placés dans les colonnes F à M

Merci

Bonjour

A vérifier

Bonjour,

Ca a l'air de fonctionner ! Merci !

J'ai juste quelques questions pour mon instruction personnelle :

For J = 2 To F1.Range("A" & Rows.Count).End(xlUp).Row

A quoi correspond cette ligne ? Surtout le .end(xlup).row ?

Et j'avoue que je ne comprends pas du tout cette partie :

T1 = Split(F1.Range("F" & J), ";")
      For I = 0 To UBound(T1)
        F2.Cells(Ligne, 6 + I) = Val(T1(I))
      Next I

La première ligne sert à la conversion des données je suppose ? D'ailleurs j'ai une question, je l'ai oublié dans mon fichier mais il y a des espaces après les points virgules. Avec cette ligne, il semble qu'il n'y ai pas besoin d'ajouter la suppression des espaces. Pourquoi?

Pour le For Next je veux bien une explication de texte si possible !

Encore merci!

Bonjour

For J = 2 To F1.Range("A" & Rows.Count).End(xlUp).Row

On fait une boucle de la ligne 2 jusqu'à la dernière ligne non vide (.End(xlUp).Row) de la colonne A : On se place sur la dernière colonne de la colonne A (F1.Range("A" & Rows.Count)) et on remonte (.End(xlUp).Row) pour obtenir le numéro de la ligne contenant une donnée

T1 = Split(F1.Range("F" & J), ";")

Coupe la donnée (F1.Range("F" & J)) en plusieurs morceaux délimités par le ; (point-virgule) : Voir l'aide

      For I = 0 To UBound(T1)
        F2.Cells(Ligne, 6 + I) = Val(T1(I))
      Next I

Copie chaque morceau de F1.Range("F" & J) (découpé par Split) dans les cellules correspondantes du tableau (fais du pas à pas et tu vas comprendre)

Val ne s'occupe pas des espaces : Val(" 10")= 10

Merci beaucoup ! C'est parfait, et je pense même avoir compris !

En fait petite question supplémentaire.

Sur mon fichier j'ai des codes qui mélanges des chiffres et des lettres.

Du coup j'utilise la ligne qui passe en format texte, mais les espaces sont toujours présent... Comment faire ? J'avoue que la je ne vois pas du tout :s

EDIT : j'ai trouvé,

J'ai écrit ça du coup :

For I = 0 To UBound(T1)
     F2.Cells(Ligne, 6 + I) = LTrim(T1(I))
     Next I

Bonjour

Remplace la partie correspondante par celle-ci

      For I = 0 To UBound(T1)
        F2.Cells(Ligne, 6 + I) = IIf(IsNumeric(T1(I)), Val(T1(I)), T1(I))
      Next I

Pour la signification de IIf voir l'aide

L'instruction équivaut à

  If IsNumeric(T1(I)) Then
    F2.Cells(Ligne, 6 + I) = Val(T1(I))
  Else
    F2.Cells(Ligne, 6 + I) = T1(I)
  End If

Bonjour,

Cette ligne ne supprimait pas l'espace avant les codes.

J'ai modifié comme ça :

For I = 0 To UBound(T1)
        F2.Cells(Ligne, 6 + I) = IIf(IsNumeric(T1(I)), Val(T1(I)), LTrim(T1(I)))
      Next I