Macro - Supprimer ligne ne comportant pas une valeur

Le 20/12/2017 à 14:36

Bonjour les gens,

J'ai un souci avec cette formule. J'ai eu du mal à la faire marcher pendant un an et maintenant que je modifie le fichier elle ne marche plus du tout

Je n'arrive pas a trouver de solution

Ce que je souhaite:

Que chaque lignes de la feuille "RT" (à partir de la troisieme) soient supprimées si en colonne AO il n'y a pas la valeur inscrite sur la feuille "BORD Saisie" en cellule E6

Je vous met la formule faisant cette opération ainsi que le fichier sur lequel elle travail.

La formule:

'SUPPRIMER LES LIGNES EN FONCTION DE 1 CASES SUR AUTRE FEUILLE

Cl.Sheets("RT").Select

Set liste = CreateObject("scripting.dictionary")

With Sheets("BORD Saisie")

For Each C In .[E6]

If C <> 0 Then liste(C.Value) = ""

Next C

End With

For Lig = Cells(Rows.Count, 41).End(xlUp).Row To 3 Step -1

If Cells(Lig, 41) <> "" Then

If Not liste.exists(1 * Cells(Lig, 41)) Then Rows(Lig).EntireRow.Delete

End If

Next Lig

Il faut vraiment que je trouve une solution facile et compréhensible car cette formule est utilisé pour 10 Macros au moins et malgré que je pense les avoir comprises et que j'ai réussi à les modifier elles ne fonctionnent plus du tout

7bord-re-saisie-modele.xlsx (98.07 Ko)

Le 20/12/2017 à 14:46

Bonjour,

Ci-joint ton fichier ...

En espérant que cela t'aide ...

27bord-re-saisie-modele.xlsm (108.14 Ko)

Le 20/12/2017 à 15:33

Bonjour

Merci beaucoup pour cette formule claire et compréhensive. Le seul HIC c'est qu'elle ne marche pas.

Le 20/12/2017 à 15:48

Re,

Il est vrai qu'avec un fichier totalement vide ... pas beaucoup de possibilités de faire un test ...

Tu peux tester le code suivant dans ton fichier :

Sub SupprimerLignes()
Dim Lig&
  With Sheets("RT")
    For Lig = .Cells(Rows.Count, 41).End(xlUp).Row To 3 Step -1
        If CLng(.Cells(Lig, 41).Value) <> CLng(Sheets("BORD Saisie").Range("E6").Value) Then .Rows(Lig & ":" & Lig).Delete
    Next Lig
  End With
End Sub

Le 20/12/2017 à 16:10

Bon ben là je pense qu'il n'y a plus rien a dire j'essayerais avec des données sur la ligne gardée pour voir si ca marche bien par ligne mais en attendant ca fonctionne parfaitement, j'ai compris et peut l'appliquer à toutes mes macros

Un énorme merci

Le 20/12/2017 à 16:12

FIORINA a écrit :
Bon ben là je pense qu'il n'y a plus rien a dire j'essayerais avec des données sur la ligne gardée pour voir si ca marche bien par ligne mais en attendant ca fonctionne parfaitement, j'ai compris et peut l'appliquer à toutes mes macros
Un énorme merci

De rien ...

Ravi que cela fonctionne ...

Merci ... pour tes remerciements ...

Cela dit .... fais très attention à ta Colonne AO ... qui a un format Texte ... alors qu'elle est supposée ne contenir que des dates ...

Le 27/12/2017 à 15:12

Bon ben je reviens vers vous car ce matin la macro ne marche plus et beug sur cette formule qui à marché quand le tableau était vide .

Voici la formule qui bloque

'SUPPRIMER LES LIGNES EN FONCTION DE 1 CASES SUR AUTRE FEUILLE

With Cl.Worksheets("Fichier Grdf")

For Lig = .Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1

If CLng(.Cells(Lig, 5).Value) <> CLng(Sheets("Pogrammation").Range("A1").Value) Then .Rows(Lig & ":" & Lig).Delete

Next Lig

End With

J'ai tout essayé et pas moyen de trouver une solution

Par ailleur j'ai un autre problème incompréhensible:

Lorsque j'execute une macro directement à partir de visual basic le copié collé du début de macro se fait bien et au bon endroit dans le fichier de destination, or quand j'execute cette macro par le biai d'un boutton, alors la le collage ne se fait pas en respectant les colonnes demandé.

Sauriez vous ce qui peut causer se problème?

Le 27/12/2017 à 15:27

Bonjour,

Avant de te demander de joindre ton fichier ...

peux-tu vérifier l'orthographe .....un r manque ... pour la feuille Programmation ...

Dans ton code ...

Sheets("Pogrammation")

ce qui devrait sans doute ... être corrigé ...

Sheets("Programmation")

Le 27/12/2017 à 15:38

Oui l'orthographe était bonne

'SUPPRIMER LES LIGNES EN FONCTION DE 1 CASES SUR AUTRE FEUILLE

With Cl.Sheets("Fichier Grdf")

For Lig = .Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1

If CLng(.Cells(Lig, 5).Value) <> CLng(.Sheets("Programmation").Range("A1").Value) Then .Rows(Lig & ":" & Lig).Delete

Next Lig

End With

Je glisse avec le fichier de destination sur lequel il y a le problème d'ailleur au collage quand j'utilise le boutton alors qu'avec visual basic non

9programmation-modele.xlsx (64.07 Ko)

Le 27/12/2017 à 16:55

Re,

Pour constater si une erreur s'est glissée ... et à surtout quel endroit ... pourquoi ne pas poster ton fichier avec la macro qui pose problème ...

Le 27/12/2017 à 18:51

Hello

A vrai dire vu les informations qu'il y a sur les fichiers il m'est assé compliqué de les partager par contre voici la macro qui me pose problème:

Sub MacroProgrammation()

'Augmenter rapidité

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Dim Cl As Workbook, Cl_1 As Workbook, CL_2 As Workbook

'Ouvre modèle Facturation Lot (Modèle)

Set Cl = Workbooks.Add(ThisWorkbook.Path & "\- Modèles\Programmation (Modèle).xlsx")

With Cl.Worksheets("Programmation")

.Range("A1").Value = Workbooks("Extraction.xlsm").Sheets("Extraction").Range("U13")

.Range("E1").Value = Workbooks("Extraction.xlsm").Sheets("Extraction").Range("U15")

End With

Set Cl_1 = Workbooks.Open(ThisWorkbook.Path & "\" & "- Sauvegarde RT" & "\" & "RT CICM 2018" & ".xlsx ")

'Enlever les filtres

With Cl_1.Sheets("Fichier Grdf")

If .AutoFilterMode Then

.Cells.AutoFilter

End If

End With

'Copie les cellules et les cole en valeur au bon endroit

Cl_1.Sheets("Fichier Grdf").Range("E3:I3010").Copy

Cl.Sheets("Fichier Grdf").Range("A2").PasteSpecial Paste:=xlPasteValues ', Operation:=xlNone, SkipBlanks

Application.DisplayAlerts = False

Cl_1.Close 'False

Application.DisplayAlerts = True

Set Cl_1 = Nothing

'Remettre Calcul pour les fonctions suivantes

Application.Calculation = xlCalculationAutomatic

'SUPPRIMER LES LIGNES EN FONCTION DE 1 CASES SUR AUTRE FEUILLE

With Cl.Sheets("Fichier Grdf")

For Lig = .Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1

If CLng(.Cells(Lig, 5).Value) <> CLng(.Sheets("Programmation").Range("A1").Value) Then .Rows(Lig & ":" & Lig).Delete

Next Lig

End With

'Enlever le calcul automatique

Application.Calculation = xlCalculationManual

'Copie les lignes de Fichier GrDF à programmation

Cl.Sheets("Fichier Grdf").Range("A2:E340").Copy

Cl.Sheets("Programmation").Range("A3").PasteSpecial Paste:=xlPasteValues ', Operation:=xlNone, SkipBlanks

'Ouvre modèle Facturation Lot (Modèle)

Set CL_2 = Workbooks.Add(ThisWorkbook.Path & "\- Modèles\Feuille de route (Modèle).xlsx")

'Copie les lignes de Fichier GrDF à programmation

Cl.Sheets("Fichier Grdf").Range("A2:E340").Copy

'Copie sur nevotec

CL_2.Sheets("Nevotec").Range("A2").PasteSpecial Paste:=xlPasteValues ', Operation:=xlNone, SkipBlanks

'Remettre Calcul pour les fonctions suivantes

Application.Calculation = xlCalculationAutomatic

'Copie feuille BORD fin de lot et la colle au même endroit en valeur

Cells.Select

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

With CL_2.Sheets("Nevotec")

'Séléctionne BORD fin de lot pour mettre en valeur B6 et Enregistre au bon endroit avec la variable en I20

CL_2.SaveAs (ThisWorkbook.Path & "\" & "Programmation" & "\" & "Feuille de route" & "\" & "Nevotec Feuille de route de " & [E2].Value & " - " & [F2].Value & ".xlsx")

End With

'Enlever le calcul automatique

Application.Calculation = xlCalculationManual

'Ferme le nouveau fichier

Workbooks("Nevotec Feuille de route de " & [E2].Value & " - " & [F2].Value & ".xlsx").Close

'Supprime L'onglet Secteur NANCY sur programmation

Application.DisplayAlerts = False

Cl.Sheets("Fichier Grdf").Delete

Application.DisplayAlerts = True

With Cl.Sheets("Programmation")

'Séléctionne BORD fin de lot pour mettre en valeur B6 et Enregistre au bon endroit avec la variable en I20

Cl.SaveAs (ThisWorkbook.Path & "\" & "Programmation" & "\" & "Prog CICM " & [A1].Value & " - " & [E1].Value & ".xlsx")

End With

'Ferme le nouveau fichier

Workbooks("Prog CICM " & [A1].Value & " - " & [E1].Value & ".xlsx").Close

'Arrête les setting

Set Cl = Nothing

Set CL_2 = Nothing

'Supprime les données sur extraction

With Workbooks("Extraction").Sheets("Extraction")

.Range("U13") = ""

.Range("U15") = ""

End With

MsgBox " C'est fini , la programmation est créé ! "

'Remettre les paramètres normaux

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub

Le 27/12/2017 à 19:09

Re,

Merci ...

Ci-joint la macro très légèrement revisitée ...

Sub MacroProgrammation()
Dim Lig As Long
Dim Cl As Workbook, Cl_1 As Workbook, CL_2 As Workbook

'Augmenter rapidité
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Ouvre modèle Facturation Lot (Modèle)
Set Cl = Workbooks.Add(ThisWorkbook.Path & "\- Modèles\Programmation (Modèle).xlsx")

With Cl.Worksheets("Programmation")
  .Range("A1").Value = Workbooks("Extraction.xlsm").Sheets("Extraction").Range("U13")
  .Range("E1").Value = Workbooks("Extraction.xlsm").Sheets("Extraction").Range("U15")
End With

Set Cl_1 = Workbooks.Open(ThisWorkbook.Path & "\" & "- Sauvegarde RT" & "\" & "RT CICM 2018" & ".xlsx ")

'Enlever le filtre
With Cl_1.Sheets("Fichier Grdf")
  If .AutoFilterMode Then .Cells.AutoFilter
End With

'Copie les cellules et les colle en valeur au bon endroit
Cl_1.Sheets("Fichier Grdf").Range("E3:I3010").Copy
Cl.Sheets("Fichier Grdf").Range("A2").PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
Cl_1.Close 'False
Application.DisplayAlerts = True

Set Cl_1 = Nothing

'Remettre Calcul pour les fonctions suivantes
Application.Calculation = xlCalculationAutomatic

'SUPPRIMER LES LIGNES EN FONCTION DE 1 Date SUR AUTRE FEUILLE
With Cl.Sheets("Fichier Grdf")
For Lig = .Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1
  If CLng(.Cells(Lig, 5).Value) <> CLng(Sheets("Programmation").Range("A1").Value) Then .Rows(Lig & ":" & Lig).Delete
Next Lig
End With

'Enlever le calcul automatique
Application.Calculation = xlCalculationManual

'Copie les lignes de Fichier GrDF à programmation
Cl.Sheets("Fichier Grdf").Range("A2:E340").Copy
Cl.Sheets("Programmation").Range("A3").PasteSpecial Paste:=xlPasteValues

'Ouvre modèle Facturation Lot (Modèle)
Set CL_2 = Workbooks.Add(ThisWorkbook.Path & "\- Modèles\Feuille de route (Modèle).xlsx")

'Copie les lignes de Fichier GrDF à programmation
Cl.Sheets("Fichier Grdf").Range("A2:E340").Copy
'Copie sur nevotec
CL_2.Sheets("Nevotec").Range("A2").PasteSpecial Paste:=xlPasteValues

'Remettre Calcul pour les fonctions suivantes
Application.Calculation = xlCalculationAutomatic

'Copie feuille BORD fin de lot et la colle au même endroit en valeur
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues

With CL_2.Sheets("Nevotec")
'Séléctionne BORD fin de lot pour mettre en valeur B6 et Enregistre au bon endroit avec la variable en I20
CL_2.SaveAs (ThisWorkbook.Path & "\" & "Programmation" & "\" & "Feuille de route" & "\" & "Nevotec Feuille de route de " & [E2].Value & " - " & [F2].Value & ".xlsx")
End With

'Enlever le calcul automatique
Application.Calculation = xlCalculationManual

'Ferme le nouveau fichier
Workbooks("Nevotec Feuille de route de " & [E2].Value & " - " & [F2].Value & ".xlsx").Close

'Supprime L'onglet Secteur NANCY sur programmation
Application.DisplayAlerts = False
Cl.Sheets("Fichier Grdf").Delete
Application.DisplayAlerts = True

With Cl.Sheets("Programmation")
'Séléctionne BORD fin de lot pour mettre en valeur B6 et Enregistre au bon endroit avec la variable en I20
Cl.SaveAs (ThisWorkbook.Path & "\" & "Programmation" & "\" & "Prog CICM " & [A1].Value & " - " & [E1].Value & ".xlsx")
End With

'Ferme le nouveau fichier
Workbooks("Prog CICM " & [A1].Value & " - " & [E1].Value & ".xlsx").Close

'Arrête les setting
Set Cl = Nothing
Set CL_2 = Nothing

'Supprime les données sur extraction
With Workbooks("Extraction").Sheets("Extraction")
  .Range("U13") = ""
  .Range("U15") = ""
End With

MsgBox " C'est fini , la programmation est créée ! "

'Remettre les paramètres normaux
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

En espérant que cela t'aide ...

Le 28/12/2017 à 00:25

Super j'ai vu les changements merci mais ca ne marche toujours pas le tri en fonction d'une case

Je comprend pas ce qui bloque

Le 28/12/2017 à 08:33

Bonjour,

Dans ta macro, je t'ai uniquement corrigé la section qui traite de la suppression des lignes liées à la date ...

De quel tri s'agit-il ...? Dans quelle macro ...?

Le 28/12/2017 à 21:11

C'est bien de ça qu'il s'agit. Tiens d'ailleurs quelques chose me vient à l'esprit. Dans la solution que tu m'as apporter il s'agissait bien d'une suppression pour les lignes ne comportant une date, or dans la dernière macro , celle qui ne marche pas c'est toujours bien une suppression mais pas par rapport à une date mais plutôt par rapport à un mot. Et une autre dans laquelle cette suppression aura lieu sera par rapport à un chiffre.

Est ce que cette nuance pourrait être là cause du problème ?

Le 29/12/2017 à 10:31

Bonjour,

J'ai l'impression que tu fais référence à une autre macro que celle tu as postée ...

Le 29/12/2017 à 10:54

Je m'explique:

J'ai en faite sur une même feuille 4 macros. 3 de ces macros utilisent la suppression de ligne en fonction d'une valeur sur une autre feuille:

1 est une suppression en fonction d'une valeur de type date (C'est la dessus qu'a commencé ce sujet) La réponse était donc pour cette macro. Cette suppression fonctionne dans ce cas
2 est une suppression en fonction d'une valeur de type nombre. Dans ce cas la suppression par rapport à une autre case ne marche pas
3 est une suppression en fonction d'une valeur de type Texte. Dans ce cas la suppression par rapport à une case ne marche pas.

Dans le cas 1 (le sujet de base) la suppression à l'air de marcher mais je n'ai pas essayé lorsqu'il est complet. Je ne m'avancerais pas trop pour l'instant pour contre les deux autre suppression dont une ou j'ai mis toute ma macro et que tu m'as modifié ne marche pas...

C'est plus compréhensible ???

Le 29/12/2017 à 11:01

Re,

Je comprends qu'il y a trois cas différents ...

Le premier cas dont tu ne sais pas encore si cela fonctione ....

et deux autres cas ...

Ma recommendation :

Avant de te lancer dans les cas N°2 et N°3 ... il est souhaitable que tu sois 100% sûre que le cas N°1 fonctionne parfaitement ...

Car une macro ne peut pas ' avoir l'air ' de marcher ....

Il faut qu'elle ait l'air et la chanson ....

Le 08/01/2018 à 12:19

Bonjour

Je reviens avec ce problème. Je souhaiterais que quelqu'un m'aide à créer une macro qui supprime toutes les lignes qui ne comporte pas dans une de leur colonne la valeur dune cellule d'une autre page

Le 08/01/2018 à 12:21

Bonjour,

Est-ce un nouveau sujet ...? et une nouvelle macro ...?

Rechercher des sujets similaires à "macro supprimer ligne comportant pas valeur"