XL 2013 Suppression ligne en fonction d'une liste d'une autre feuille

Olivier33390

XLDnaute Nouveau
Bonjour,
j'ai un fichier avec 2 feuilles dont la 1ère contient une base de données avec entre autre la colonne "OTM" et la 2ème feuille qui contient une liste d'OTM à conserver.
Le but est de supprimer les lignes de la 1ère feuille dont l'OTM de la colonne "OTM" ne fait pas partie de la liste d'OTM de la 2ème feuille.
Bien évidemment le nombre de ligne de la 1ère feuille est variable en fonction des extractions, et la liste des OTM de la 2ème feuille est variable mais sur une seule colonne.
Merci de votre aide.
PS: je ne pourrai pas joindre de fichier pour cause de confidentialité.
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Olivier

Olivier
Le fichier orignal, non (car on ne joint jamais de fichier original, c'est gravé dans le marbre de la charte ;))
Mais rien de t'empêche de créer un fichier allégé et avec des données bidons qui reprennent la structure de ton classeur d'origine
(avec même noms de feuille, même plage de cellules, même formules etc...)
 
Dernière édition:

Olivier33390

XLDnaute Nouveau
Bonjour à tous,
je viens de trouver un code sur la page de nounbxl76 qui fonctionne bien:

Option Explicit
Sub OTM_MC()
Dim c As Range, i As Long
Application.ScreenUpdating = False
Sheets("Extraction TEM").Activate
For i = Cells(Rows.Count, "k").End(xlUp).Row To 2 Step -1
Set c = Sheets("OTM ACT sensibles").Columns(1).Find(Range("k" & i).Value)
If c Is Nothing Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
'
End Sub

Pour autant, est-il de possible de mettre le titre de la colonne en lieu et place des lettres K pour la feuille "Extraction TEM" et columns(1) pour la feuille "OTM ACT sensibles"?

Merci de votre retour.

Cdt
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

VB:
Sub OTM_MC2()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Extraction TEM")
    Set f2 = Sheets("OTM ACT sensibles")
    p = Application.Match("N°OTM", f1.[A1:Z1], 0)
    p2 = Application.Match("OTM - MC", f2.[A1:Z1], 0)
    If Not IsError(p2) Then
      n = f2.Cells(65000, p2).End(xlUp).Row
      liste = f2.Cells(2, p2).Resize(n - 1)
    End If
    If Not IsError(p) And Not IsError(p2) Then
       For i = f1.Cells(Rows.Count, p).End(xlUp).Row To 2 Step -1
          c = Application.Match(f1.Cells(i, p), liste, 0)
          If IsError(c) Then f1.Rows(i).Delete
       Next i
    End If
    Application.ScreenUpdating = True
End Sub

S'il y a des milliers de lignes, on peut faire + rapide.

Boisgontier
 

Pièces jointes

  • Copie de test macro OTM MC light.xlsm
    21.8 KB · Affichages: 5
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 723
Messages
2 081 934
Membres
101 844
dernier inscrit
pktla