Aide sur Macro VBA - copie lignes sous condition(s)

fahki

XLDnaute Nouveau
Bonjour à tous,

Après avoir écumé des dizaines de forums sur internet, je m'en remet à vous.

J'ai un problème avec une macro VBA.

Il y a plusieurs véhicules dans la feuille "B", j'aimerais que pour chacun de ces véhicules, la macro balaye la feuille "vieux stock" et trouve des véhicules correspondants. Par correspondant j'entends même modèle. 208 pour 208, RCZ pour RCZ etc.

Les étapes se feraient donc comme suit :
1) La macro va dans la feuille "B", copie la 1ère et 2e ligne puis, colle dans la feuille "A"
2) Aller ligne suivante et inscrire "VEHICULES CORRESPONDANTS"
3) Comparer la cellule I2 (où est inscrit le modèle, feuille "A") avec toutes les cellules G de la feuille "Vieux_stock" (où sont également entrés les modèles)
4) Pour chaque correspondance trouvée, copier la ligne en dessous de "VEHICULES CORRESPONDANTS"

Et ainsi de suite, pour chaque ligne de la feuille "B"

Voici le code :

HTML:
Sub Macro4()
'
' Macro4 Macro
' Macro enregistrée le 27/07/2012 par Guillaume JEAN
'

'Premier véhicule

    Sheets("A").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("B").Select
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select
    Range("A1:P2").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("A").Select
    ActiveCell.Offset(2, 0).Select
    
    
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "VEHICULES CORRESPONDANTS"
    ActiveCell.Offset(1, 0).Select
    Sheets("Vieux_stock").Select
    
End Sub
'Matchage premier véhicule



'- sélection de la feuille "à lire" ("Vieux stock")
'- lecture de chaque ligne, tant que la cellule "G" n'est pas vide
'- si la ligne répond à la condition, alors écriture des données dans la feuille "à écrire"


Sub Procedure()

Dim DerniereLigne As Long 'dans la feuille à écrire
Dim LigneActive As Long 'dans la feuille à lire



Sheets("Vieux_Stock").Select
Range("G4").Select

While ActiveCell.Value <> Empty
LigneActive = ActiveCell.Row 'n° de la ligne "à lire"
If Cells(LigneActive, 6).Value = Sheets("A").Range("I2").Value Then 

'écriture dans la feuille "A"
With Sheets("A")
DerniereLigne = .Range("A65536").End(xlUp).Offset(1, 0).Row 'n° de la ligne "à écrire"

End With

End If
ActiveCell.Offset(1, 0).Activate

Wend
End Sub


Je vous remercie par avance de votre sollicitude, bon week-end à tous !

Guillaume

PS : je vous donne un lien pour le fichier dès que je suis chez moi, mon entreprise interdisant tous les sites type cjoint, free.fr etc.
 

job75

XLDnaute Barbatruc
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Bonjour fahki, bienvenue sur XLD,

D'après ce que je vois les colonnes de la feuille Vieux_stock sont très différentes de celles de la feuille B.

Alors pour le point 4) du post #1 on copie quoi :confused:

A+
 

fahki

XLDnaute Nouveau
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Salut job75, merci de ta réponse :)

Les colonnes sont très différentes c'est vrai, mais après je ferais ma sauce pour savoir quelle colonne va dans quelle colonne, ça je sais faire. As-tu une idée quant à la résolution de mon problème ?
Bonne journée
 

job75

XLDnaute Barbatruc
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Re,

Je comprends donc que vous voulez copier toutes les colonnes de la feuille Vieux_stock.

Pas bien fameux, mais enfin vous pouvez utiliser cette macro, qui n'est pas très compliquée :

Code:
Sub VieuxStock()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet
Dim derlig&, d As Object, lig&, i&, t$, j&
Set F1 = Sheets("B")
Set F2 = Sheets("A")
Set F3 = Sheets("Vieux_stock")
derlig = F3.[G65536].End(xlUp).Row
Set d = CreateObject("Scripting.Dictionary")
lig = 1 'pour la feuille F2
For i = 2 To F1.[I65536].End(xlUp).Row
  t = Trim(F1.Cells(i, "I"))
  If t <> "" And Not d.Exists(t) Then
    d(t) = t
    F1.Rows(1).Copy F2.Rows(lig)
    lig = lig + 1
    F2.Cells(lig, 1).Resize(, 17) = F1.Cells(i, 1).Resize(, 17).Value
    lig = lig + 1
    F2.Cells(lig, 1) = "VEHICULES CORRESPONDANTS"
    lig = lig + 1
    For j = 4 To derlig
      If Trim(F3.Cells(j, "G")) = t Then
        F2.Cells(lig, 1).Resize(, 28) = F3.Cells(j, 1).Resize(, 28).Value
        lig = lig + 1
      End If
    Next
    lig = lig + 1 'si l'on veut une ligne vide
  End If
Next
F2.Activate 'facultatif
End Sub
Nota : pas très génial d'avoir mis des espaces après les noms de modèles en feuille B...

Edit : le lien sur cjoint.com :

http://cjoint.com/?BGDvyeVLjEZ

La macro est dans Module7, cliquer sur le bouton en feuille B pour la lancer.

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Bonjour fahki, le forum,

Il est plus prudent en feuille A (F2) avant d'exécuter la boucle :

- d'effacer complètement toutes les cellules

- de mettre les colonnes au format Texte, sauf la colonne P car il y a des dates :

Code:
Sub VieuxStock()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet
Dim derlig&, d As Object, lig&, i&, t$, j&
Set F1 = Sheets("B")
Set F2 = Sheets("A")
Set F3 = Sheets("Vieux_stock")
derlig = F3.[G65536].End(xlUp).Row
Set d = CreateObject("Scripting.Dictionary")
lig = 1 'pour la feuille F2
Application.ScreenUpdating = False
F2.Cells.Clear 'RAZ
F2.[A:O,Q:AB].NumberFormat = "@" 'format Texte
For i = 2 To F1.[I65536].End(xlUp).Row
  t = Trim(F1.Cells(i, "I"))
  If t <> "" And Not d.Exists(t) Then
    d(t) = t
    F1.Rows(1).Copy F2.Rows(lig)
    F2.Cells(lig + 1, 1).Resize(, 17) = F1.Cells(i, 1).Resize(, 17).Value
    F2.Cells(lig + 2, 1) = "VEHICULES CORRESPONDANTS"
    lig = lig + 3
    For j = 4 To derlig
      If Trim(F3.Cells(j, "G")) = t Then
        F2.Cells(lig, 1).Resize(, 28) = F3.Cells(j, 1).Resize(, 28).Value
        lig = lig + 1
      End If
    Next
    lig = lig + 1 'si l'on veut une ligne vide
  End If
Next
F2.Columns("B:AB").AutoFit 'ajuste la largeur des colonnes
F2.Activate 'facultatif
End Sub
Le lien vers le fichier (2) :

http://cjoint.com/?BGElkDqQR1Q

Edit : ajouté F2.Columns("B:AB").AutoFit 'ajuste la largeur des colonnes

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Re,

Voici une version (3) qui parait meilleure.

Dans les versions précédentes une seule ligne de la feuille B était copiée au dessus de "VEHICULES CORRESPONDANTS".

Maintenant toutes les lignes avec le même modèle sont copiées :

Code:
Sub VieuxStock()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet
Dim derlig1&, derlig3&, d As Object, lig&, i&, t$, j&
Set F1 = Sheets("B")
Set F2 = Sheets("A")
Set F3 = Sheets("Vieux_stock")
derlig1 = F1.[I65536].End(xlUp).Row
derlig3 = F3.[G65536].End(xlUp).Row
Set d = CreateObject("Scripting.Dictionary")
lig = 1 'pour la feuille F2
Application.ScreenUpdating = False
F2.Cells.Clear 'RAZ
F2.[A:O,Q:AB].NumberFormat = "@" 'format Texte
For i = 2 To derlig1
  t = Trim(F1.Cells(i, "I"))
  If t <> "" And Not d.Exists(t) Then
    d(t) = t
    F1.Rows(1).Copy F2.Rows(lig)
    lig = lig + 1
    For j = i To derlig1
      If Trim(F1.Cells(j, "I")) = t Then
        F2.Cells(lig, 1).Resize(, 17) = F1.Cells(j, 1).Resize(, 17).Value
        lig = lig + 1
      End If
    Next
    F2.Cells(lig, 1) = "VEHICULES CORRESPONDANTS"
    lig = lig + 1
    For j = 4 To derlig3
      If Trim(F3.Cells(j, "G")) = t Then
        F2.Cells(lig, 1).Resize(, 28) = F3.Cells(j, 1).Resize(, 28).Value
        lig = lig + 1
      End If
    Next
    lig = lig + 1 'si l'on veut une ligne vide
  End If
Next
F2.Columns("B:AB").AutoFit 'ajuste la largeur des colonnes
F2.Activate 'facultatif
End Sub
Voyez pour les modèles 207, 3008 et 308.

Le lien vers le fichier (3) :

http://cjoint.com/?BGErjk347MK

A+
 

fahki

XLDnaute Nouveau
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Bonjour Job75,

Ton code marche bien, merci encore pour ton aide. Cela dit, désireux de ne pas être un simple exécutant de ton travail, j'aimerais comprendre cette macro. J'ai plusieurs interrogations :

Code:
Dim derlig1&, derlig3&, d As Object, lig&, i&, t$, j&

Tu définis d As Object, que cela signifie-t-il ?
Tu définis les variables avec "&" pour la plupart mais avec "$" pour t. Pourquoi ? Quelle est la différence ?


Code:
Set d = CreateObject("Scripting.Dictionary")
Que signifie Scripting.Dictionary ?
Si je comprends bien, tu crées un objet avec pour propriété Scripting Dictionary ?


Code:
For i = 2 To derlig1
  t = Trim(F1.Cells(i, "I"))                       
  If t <> "" And Not d.Exists(t) Then
    d(t) = t
    F1.Rows(1).Copy F2.Rows(lig)
    lig = lig + 1
    For j = i To derlig1
      If Trim(F1.Cells(j, "I")) = t Then
        F2.Cells(lig, 1).Resize(, 17) = F1.Cells(j, 1).Resize(, 17).Value
        lig = lig + 1
      End If
    Next
    F2.Cells(lig, 1) = "VEHICULES CORRESPONDANTS"
    lig = lig + 1
    For j = 4 To derlig3
      If Trim(F3.Cells(j, "G")) = t Then
        F2.Cells(lig, 1).Resize(, 28) = F3.Cells(j, 1).Resize(, 28).Value
        lig = lig + 1
      End If
    Next
    lig = lig + 1 'si l'on veut une ligne vide
  End If
Next
F2.Columns("B:AB").AutoFit 'ajuste la largeur des colonnes
F2.Activate 'facultatif
End Sub


Pour toutes ces lignes, peux tu m'expliquer ? Je suis sincèrement désolé, je sais que ça prend du temps, mais j'ai réellement envie de progresser et je suis convaincu que comprendre ce code m'aidera dans mes futures problématiques..

Guillaume
 

job75

XLDnaute Barbatruc
Re : Aide sur Macro VBA - copie lignes sous condition(s)

Bonjour fahki,

Je déclare les variables :

- Dim d As Object parce que ce sera un objet "Scripting.Dictionary"

-Dim derlig1& : c'est la même chose que Dim derlig1 As Long

- Dim t$ : c'est la même chose que Dim t As String.

Le code est facile à comprendre, et quand vous ne comprenez pas un mot, prenez l'habitude d'aller interroger l'Aide VBA par la touche F1.

C'est comme cela que vous progresserez.

A+
 

Discussions similaires

Réponses
2
Affichages
536

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof