regrouper trois instructions renvoi, vloockup et delete

teter

XLDnaute Junior
Bonjour à tous,

J’ai encore besoin de votre aide, voici le sujet.
Je dispose de 2 fichiers : "nom" et "fréquence".
Dans le fichier nom, 2 feuilles : "source" et "result" :
- feuille "source" : la colonne A contient des codes (010105N, 010204C, ….), la colonne "E" contient des noms et les autres colonnes des données diverses,
- feuille "result" : la colonne A contiendra des noms de la feuille précédente, la colonne B la fréquence.
Dans le fichier "fréquence", une feuille "freq" dont la colonne A contient des noms et la colonne B des fréquences : D, W, M, Q, autres.

Je cherche dans mon fichier "nom", feuille "résultat", tous les noms dont le code commence par "0106" et dont la fréquence est différentes de "D", "W" ou "M".
Je procède en trois étapes :
1. je renvoie de ma feuille "source" à ma feuille "result" les noms pour lesquels le code commence par 0106,
2. par un VLOOKUP dans ma feuille "result", colonne B, je vais chercher les fréquences dans mon fichier "fréquences",
3. je supprime toutes les lignes dont la fréquence est "D", "W" ou "M".

Je cherche à supprimer l’étape 3 car ma zone d’impression est à chaque fois modifiée par les lignes supprimées et je pense qu'il y a moyen de tout mettre en une seule instruction mais je ne sais pas comment.

Une p’tite idée ?

Merci d’avance
A+

Teter


1.
Dim x As Range
Sheets("source").Select
For Each x In Sheets("source").Range("A2:" & Range("A65536").End(xlUp).Address)
If Left(x, 4) = "0106" Then
Cells(x.Row, 5).Copy (Sheets("result").Range("B65536").End(xlUp).Offset(1, 0))
End If
Next

2.
Sheets("result").Activate
Range("B1").Select
ActiveCell.FormulaR1C1 = "Freq."
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'C….[fréquence.xls]freq'!C1:C2,2,)"
Range("B2:B" & Range("A65000").End(xlUp).Row).FillDown

3.
Dim y As Variant
For y = Cells(2, 2).CurrentRegion.Rows.Count To 1 Step -1
If Cells(y, 2).Value = "D" Or Cells(y, 2).Value = "W" Or Cells(y, 2).Value = "M" Then Cells(y, 2).EntireRow.Delete
Next
 

Discussions similaires

Réponses
6
Affichages
227