VBA Supprimer une ligne en fonction de la valeur d'une cases
Bonjour
Je suis novice en matière de VBA j’apprends sur le tas. Je suis plutôt fière de moi car j'ai presque tout réussi à faire se que je voulais tel que créer des classeurs y mettre des données les traiter et enregistrer le tout sou sun nom défini et variable que du bonheur quoi.
En plus de ne pas être encore trés au point il me reste deux problèmes a régler ou je vais enfin demander de l'aide:
un des problèmes est le suivant:
Je souhaiterais supprimer les lignes d'une feuille si dans une de ses cases il y a une valeur différente d'une des 5 cases situé sur une autre feuille.
Je détail pour simplifier nos échange:
Feuille 1: tableau avec la colonne E où est noté pour chaque ligne le numéro de la semaine du passage du technicien (plusieurs lignes avec ce numéro)
Feuille 2: A1,A2,A3,A4,A5 sont 5 cases modifiables qui comportent un numéro de semaine
Je veux donc que sur ma feuille 1 toutes les cases en colonne E comportant une autre valeur que celle de A1,A2,A3,A4,A5 de la feuille 2 soient supprimées
J'ai essayé plein de code trouvé sur internet mais rien ne marche. J'ai essayer de faire la manipulation en enregistrant les manipulation et utiliser le code pour qu'il s'automatise mais rien n'y fait.
Si toutefois vous souhaitez voir la macro je peux la mettre
Pour le deuxième problème je fais un autre poste
Bonjour FIORINA,
Avec un fichier en guise d'exemple, on aurait été plus sûrs de bien comprendre, on aurait pu donner des indications plus précises, on aurait pu s'assurer qu'il n'existait pas de situations particulières, on aurait eu une idée plus précise du volume de lignes à traiter, etc.
... Bref, teste toujours ce qui suit (à coller dans la fenêtre de code de la Feuille1):
Sub test()
For lig = Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
If Application.CountIf(Feuil2.[A1:A5], Cells(lig, 5)) = 0 Then Rows(lig).EntireRow.Delete
Next lig
End SubLe 'Feuil2' sera peut-être à adapter!?
Alors voila pour la vba:
Sub ExportFacturation()
Dim Cl As Workbook
Dim Fe As Worksheet
Set Fe = Worksheets("RT-C")
Application.ScreenUpdating = False
Set Cl = Workbooks.Add
With Cl
.SaveAs ("Facturation CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & ".xls")
Windows("Facturation CICM - Oti France - S13.xls").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
Windows("Gestion BRC.xlsm").Activate
Windows("Gestion BRC.xlsm").Activate
Fe.Copy .Worksheets("Feuil1")
Application.DisplayAlerts = False
.Worksheets("Feuil1").Delete
Windows("Facturation CICM - Oti France - S13.xls").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Gestion BRC.xlsm").Activate
Application.DisplayAlerts = True
.Save
Windows("Gestion BRC.xlsm").Activate
End With
Application.ScreenUpdating = True
Set Fe = Nothing
Set Cl = Nothing
Windows("Facturation CICM - Oti France - S13.xls").Activate
Columns("AA:AB").Select
Selection.Delete Shift:=xlToLeft
Columns("Y:Y").Select
Selection.ColumnWidth = 60
Windows("Gestion BRC.xlsm").Activate
Windows("Facturation CICM - Oti France - S13.xls").Activate
Windows("Gestion BRC.xlsm").Activate
Sheets("BORD LORRAINE").Select
Sheets("BORD LORRAINE").Copy After:=Workbooks( _
"Facturation CICM - Oti France - S13.xls").Sheets(1)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("Extraction").Select
End Sub
J'ai rajouter le code donné plus haut mais ca ne marche pas ça me supprime toute ma deuxième page ne me laissant que les photos. Voici donc la macro qui marche et que j'utilise sur laquelle il faut regler mes deux probèmes.
Il faut donc que soit supprimé sur la page "RT-C" toutes les lignes qui dans la colones "I" n'ont pas une des 5 valeurs situé en case B13,B14,B15,B16,B17, de ma deuxième page "BORD LORRAINE"
Si vous avez la solution à mon autre problème qui est que j'aimerais choisir le fichier on vont être enregistrés tous les fichiers créés par cette macro mais je trouve pas
Re,
Un fichier permettait bien ce que j'évoquais plus haut: les situations particulières ne manquaient pas ...
- sur tes 5 cellules renseignant les n° de semaines, 2 contenaient un zéro
- tes n° de semaines (colonne I) sont au format texte
- certaines cellules de la colonne I semblent vides ... mais ne le sont pas!
... Toujours dans la fenêtre de code de la feuille "RT-C", essaie:
Sub test()
Set liste = CreateObject("scripting.dictionary")
With Sheets("BORD LORRAINE")
For Each c In .[B13:B17]
If c <> 0 Then liste(c.Value) = ""
Next c
End With
For lig = Cells(Rows.Count, 9).End(xlUp).Row To 5 Step -1
If Cells(lig, 9) <> "" Then
If Not liste.exists(1 * Cells(lig, 9)) Then Rows(lig).EntireRow.Delete
End If
Next lig
End SubPas regardé au reste du code!
Pas regardé non plus pour ton autre question!
Hé Bim en deux secondes, c'est resolu !!! Que c'est magnifique !!!
Juste pour le plaisir voici la macro resultante:
Sub ExportFacturation()
Dim Cl As Workbook
Dim Fe As Worksheet
Set Fe = Worksheets("RT-C")
Application.ScreenUpdating = False
Set Cl = Workbooks.Add
With Cl
.SaveAs ("Facturation CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & ".xls")
Windows("Facturation CICM - Oti France - S13.xls").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
Windows("Gestion BRC.xlsm").Activate
Windows("Gestion BRC.xlsm").Activate
Fe.Copy .Worksheets("Feuil1")
Application.DisplayAlerts = False
.Worksheets("Feuil1").Delete
Windows("Facturation CICM - Oti France - S13.xls").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Gestion BRC.xlsm").Activate
Application.DisplayAlerts = True
.Save
Windows("Gestion BRC.xlsm").Activate
End With
Application.ScreenUpdating = True
Set Fe = Nothing
Set Cl = Nothing
Windows("Facturation CICM - Oti France - S13.xls").Activate
Columns("AE:AF").Select
Selection.Delete Shift:=xlToLeft
Columns("Y:Y").Select
Selection.ColumnWidth = 44
Windows("Gestion BRC.xlsm").Activate
Windows("Facturation CICM - Oti France - S13.xls").Activate
Windows("Gestion BRC.xlsm").Activate
Sheets("BORD LORRAINE").Select
Sheets("BORD LORRAINE").Copy After:=Workbooks( _
"Facturation CICM - Oti France - S13.xls").Sheets(1)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Facturation CICM - Oti France - S13.xls").Activate
Sheets("RT-C").Select
Set liste = CreateObject("scripting.dictionary")
With Sheets("BORD LORRAINE")
For Each C In .[B13:B17]
If C <> 0 Then liste(C.Value) = ""
Next C
End With
For lig = Cells(Rows.Count, 9).End(xlUp).Row To 5 Step -1
If Cells(lig, 9) <> "" Then
If Not liste.exists(1 * Cells(lig, 9)) Then Rows(lig).EntireRow.Delete
End If
Next lig
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("Extraction").Select
End Sub
J'ai donc rajouter la proposition (en vert) en rappelant le fichier et la feuille en question et paf ça marche
Il manque plus que j'arrive à enregistrer cette feuille crée par la macro dans un dossier spécifique et mes macros sont finis pour cette partie.
Sauriez vous comment faire?
Avant tou mille merci à U.Milité tu n'imagine pas comment tu me sors du c....
Bonjour
Je souhaite compléter la suite de mon fichier en refaisant presque la même manipulation sauf que là la valeur critère est "BORD fin de lot" la case B6
Il faut donc supprimer sur "Secteur NANCY" toutes les lignes qui ne comportent pas en Colonne A , notre case Critère
Voici la macro avec l'endroit d'où vient l'erreur
Sub ExportLot()
Dim Cl As Workbook
Dim Fe As Worksheet
Set Fe = Worksheets("Secteur NANCY")
Application.ScreenUpdating = False
Set Cl = Workbooks.Add
With Cl
.SaveAs ("Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls")
Windows("Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
Windows("Gestion BRC.xlsm").Activate
Windows("Gestion BRC.xlsm").Activate
Fe.Copy .Worksheets("Feuil1")
Application.DisplayAlerts = False
.Worksheets("Feuil1").Delete
Windows("Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Gestion BRC.xlsm").Activate
Application.DisplayAlerts = True
.Save
Windows("Gestion BRC.xlsm").Activate
End With
Application.ScreenUpdating = True
Set Fe = Nothing
Set Cl = Nothing
Windows("Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls").Activate
Columns("AE:AF").Select
Selection.Delete Shift:=xlToLeft
Columns("Y:Y").Select
Selection.ColumnWidth = 44
Windows("Gestion BRC.xlsm").Activate
Windows("Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls").Activate
Windows("Gestion BRC.xlsm").Activate
Sheets("BORD fin de lot").Select
Sheets("BORD fin de lot").Copy After:=Workbooks( _
"Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls").Sheets(1)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'SUPPRIMER LES LIGNES EN FONCTION DE 5 CASES SUR AUTRE FEUILLE
Windows("Facturation fin de lot CICM - Oti France" & " " & "- S" & Format(Date, "ww") - 1 & "." & Format(Date, "yyyy") & ".xls").Activate
Sheets("Secteur NANCY").Select
Set liste = CreateObject("scripting.dictionary")
With Sheets("BORD fin de lot")
For Each C In .[B6]
If C <> 0 Then liste(C.Value) = ""
Next C
End With
For lig = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step 1
If Cells(lig, 1) <> "" Then
If Not liste.exists(1 * Cells(lig, 1)) Then Rows(lig).EntireRow.Delete
End If
Next lig
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("Extraction").Select
Pourriez vous m'aider SVP?
Bonsoir,
Je me disais aussi que ton "Bim ... résolu en deux secondes" sentait fort l'enthousiasme prématuré
Ton code donne un peu l'impression que tu utilises l'enregistreur de macro, puis que tu y ajoutes une pincée de bouts de code puisés à droite ou à gauche. Tu me diras sans doute que l'essentiel est que ça fonctionne, mais encore faut-il comprendre pour adapter ...
- tu parles d'une valeur critère qui serait "BORD fin de lot" mais dans ton code, c'est du nom d'une feuille qu'il s'agit!?
- d'autre part, tu écris "For Each C In .[B6]" ... ce qui semble d'un intérêt assez discutable
- enfin, nous ne disposons pas d'un fichier qui permettrait de mieux voir ce que tu essayes de faire
- la fois passée, je n'avais pas regardé le reste de ton code ... aujourd'hui, j'ai essayé de comprendre les premières lignes ... et je ne suis arrivé à rien
Tu crées un nouveau classeur que tu enregistres, puis tu actives ce même classeur (?) tu sélectionnes toutes les cellules (sans préciser de quelle feuille il pourrait s'agir) et tu les copies (mais les cellules d'un nouveau classeur ne sont-elles pas vierges?) et tu les colles ... au même endroit!
En faite la macro dont jai copie la formule marche parfaitement bien cest juste que je souhaite adapter cette formule à cette situation qui est exactement la même sauf qu il n'y a qu'un critère de sélection et qui se cherche dans une autre colonne
Pour se qui est de mon language vba il est bien tiré de quelques enregistrementcombine a des textes trouve sur le net. Je n'arrive pas à mieux organiser et ca me bloque car je n'arrive pas à à enregistrer avec un chemin de destination...
La partie en surligneur est la partie à modifier pour avoir qu'une case sélection
Arrive tu às modifier ou dois tout refaire???