VBA Transférer des données avec condition

ThomasBerth

XLDnaute Nouveau
Bonjour à tous,
Débutant en VBA je viens vous solliciter pour enfin réussir à faire marcher mon programme.

Voici ce que j'aimerais réaliser :
J'ai deux feuilles existantes, une qui contient des données et une qui doit recevoir des données. Dans la feuille de données, appelons la "A", ma colonne E contient des chiffres (Nombre de jours), cette colonne a des cellules blanches qui séparent des groupes de chiffre. J'aimerais réaliser un programme qui vient balayer chaque lignes depuis le bas de cette colonne, consulter le contenu des cellules de la colonne B pour chaque lignes, et en fonction des valeurs dans les cellules de la colonne B (Par exemple "Dépann"), qu'il transfère le chiffre présent dans la colonne E sur la même ligne, vers ma feuille B dans une colonne ayant pour intitulé "Dépannage" à la ligne 1. Lorsque que le programme arrive sur une ligne vide de ma feuille A, il va sauter une ligne sur la feuille B afin d'inscrire le prochains chiffre (de ma colonne E) à une ligne en dessous de celle-ci. Pour illustrer ce que j'essaie d'expliquer ici j'ai joint des captures d'écran de mes 2 feuilles.

Il faudrait donc que pour le numéro d'avis 1008132, dans la ligne 3 de ma feuille B, il y ai 6 dans la cellule de la colonne "Dépannage", 1 dans la colonne Cablâge, rajouter 1 à la valeur déjà inscrite dans la colonne "Dépannage", etc... et pour le numéro d'avis 1008497, insérer dans la ligne 4 de ma feuille B, 6 dans la cellule de la colonne "Salle d'attente, rajouter 4 à cette valeur, 0 en "contrôle d'entrée" etc...

Voici le code que j'ai tenté d'écrire, seulement il est incomplet et je ne parvient pas à trouver ce qu'il manque pour qu'il fonctionne. Merci d'avance pour quiconque prendra du temps pour m'aider !
N'hésitez pas à me dire si certains aspects ne sont pas clair, je ferai de mon mieux pour fournir plus d'informations pouvant aider à comprendre.
VB:
Dim y As Long, z As Long, Position As Long
    With ActiveSheet
        lastErow = .Cells(.Rows.Count, "E").End(xlUp).Row
    End With
    With ActiveWorkbook.Worksheets("Feuil1")
        firstrow = .Cells(.Rows.Count, "D").End(xlUp).Row
    End With
    For y = lastErow To 3 Step -1
        For z = firstrow To 50 Step 1
            If Cells(y, 4).Value = "" Then
                z = z + 1
            ElseIf Cells(y, 4).Value <> "" Then
                    If ActiveCell.Offset(y - 2, 1).Value = " Ctrl Entrée" Then
                    ActiveWorkbook.Worksheets("Feuil1").Cells(z, 1).Value = Cells(y - 2, 4)
                    End If
            End If
        Next
    Next
End Sub
 

Fichiers joints

Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Bonjour et bienvenu,
Travailler sur des images c'est pas des plus facile.
Ha un truc il faut bien nommer tes entêtes en feuil2 comme en Feuil1
exemple….. Dépann en feuil1 et Dépannage en feuil2
Une fois rectifier tu peux exécuter cette macro.
La prochaine fois créé un fichier exemple avec qlq lignes cela évite de devoir refaire….
Bruno
VB:
Sub MyRecap()
Dim k, lig, col
Feuil2.[A3:Z1000].ClearContents
lig = 2
For k = 2 To Feuil1.[A65000].End(3).Row
If Feuil1.Cells(k, 1) = "" Then
k = k + 1: lig = lig + 1
Feuil2.Cells(lig, 1) = Feuil1.Cells(k, 1)
End If
col = Application.Match(Cells(k, 2), Feuil2.[A2:Z2], 0)
Feuil2.Cells(lig, col) = Feuil2.Cells(lig, col) + Feuil1.Cells(k, 5)
Next
End Sub
 

ThomasBerth

XLDnaute Nouveau
Bonjour youky(BJ),

J'ai préféré insérer des captures d'écran car j'ai lu sur certaines discussions que les classeurs en fichier joint sont rarement ouvert car potentiellement dangereux.

Quant au code que vous m'avez envoyé, j'ai modifié mes noms d'en-têtes et j'ai testé le code, ça fonctionne. Merci beaucoup !
 

Discussions similaires


Haut Bas