Recherche automatique de valeurs

[panpipes]

Bonjour,

Je rencontre un problème sous VBA pour automatiser la rechercher et la copie de valeurs d'un tableau de données Excel vers un autre fichier Excel.

Je joins à ce post le fichier de base contenant les données à l'état brut (FullTest1) et le fichier avec la macro et les valeurs finales à copier.


Le fichier de données comporte en fonction des horaires les arrivées, opération et départs de plusieurs moyens de transport.
Seuls 4 de ces moyens de transport m'intéressent (Voitures 1,2,3 et 4), et je voudrais que la macro contenue dans le second fichier puisse afficher pour chaque voiture les arrivées et départ de chaque ville.

Je coince au niveau de la copie automatique de ces valeurs.

Je pense que le code doit ressembler à cela:
si le moyen de transport (colonne B) correspond à la voiture 1, et si l'activité associée (colonne E) est une arrivée, alors je copie la ville (colonne F) et l'heure d'arrivée (colonne A) dans l'onglet associé du second fichier. Je rentre cette ville comme variable, je cherche le prochain départ et je copie la date associée dans le second fichier.
Sinon je fais la même recherche pour les voitures 2,3,4
Sinon je passe à la ligne suivante tant que je ne suis pas arrivé à la fin.

Je me suis déjà aidé d'autre morceaux de codes pour ce que j'ai déjà réalisé, mais pour cette partie, je coince au niveau de la retranscription...

Je vous remercie d'avance pour le temps que vous prendrez à m'aider, et je vous souhaite un bon week-end!!!

Merci,

Panpipes

 

[Yaloo]

Re : Recherche automatique de valeurs

Bonsoir panpipes,

Avec ce type de macro, ça doit le faire :

Option Explicit

Sub récap()
Dim d As Workbook, i&
Set d = Workbooks.Open(ThisWorkbook.Path & "\Fulltest1.xlsx")
ThisWorkbook.Activate
For i = 2 To d.Sheets(1).[B65536].End(3).Row
  If d.Sheets(1).Cells(i, 2) = "VOITURE 1" And d.Sheets(1).Cells(i, 5) = "ARR" Then
    Sheets(2).Range("A" & Sheets(2).[A65536].End(3)(2).Row) = d.Sheets(1).Cells(i, 6)
    Sheets(2).Range("B" & Sheets(2).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 1" And d.Sheets(1).Cells(i, 5) = "DEP" Then
    Sheets(2).Range("C" & Sheets(2).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 2" And d.Sheets(1).Cells(i, 5) = "ARR" Then
    Sheets(3).Range("A" & Sheets(3).[A65536].End(3)(2).Row) = d.Sheets(1).Cells(i, 6)
    Sheets(3).Range("B" & Sheets(3).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 2" And d.Sheets(1).Cells(i, 5) = "DEP" Then
    Sheets(3).Range("C" & Sheets(3).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 3" And d.Sheets(1).Cells(i, 5) = "ARR" Then
    Sheets(4).Range("A" & Sheets(4).[A65536].End(3)(2).Row) = d.Sheets(1).Cells(i, 6)
    Sheets(4).Range("B" & Sheets(4).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 3" And d.Sheets(1).Cells(i, 5) = "DEP" Then
    Sheets(4).Range("C" & Sheets(4).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 4" And d.Sheets(1).Cells(i, 5) = "ARR" Then
    Sheets(5).Range("A" & Sheets(5).[A65536].End(3)(2).Row) = d.Sheets(1).Cells(i, 6)
    Sheets(5).Range("B" & Sheets(5).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  ElseIf d.Sheets(1).Cells(i, 2) = "VOITURE 4" And d.Sheets(1).Cells(i, 5) = "DEP" Then
    Sheets(5).Range("C" & Sheets(5).[A65536].End(3).Row) = d.Sheets(1).Cells(i, 1)
  End If
Next
End Sub

A te relire

Martial

 

[panpipes]

Re : Recherche automatique de valeurs

Bonjour Martial,

Tout d'abord, merci pour le temps que tu as passé pour me répondre.

J'ai remis ce code pour l'ensemble des données que j'ai (c'est pour ça que j'ai mis quelques jours à répondre, je ne suis pas très rapide comme je débute sur VBA) et c'est bon pour moi.

Merci pour ce code et la structure en tout cas !

Bonne journée,

Panpipes