Aide macro

B

BRUNO62

XLDnaute Occasionnel
Ci-JT la macro pour laquelle tout fonctionne sauf la dernière étape qui consiste à supprimer toutes les lignes doté d'une certaine valeur
A partir de là. Ca mouline à ne plus en finir !!

Avez vous une idée ?
Merci.
a+


Sub MacroCorrigéEtSimplifié()
' Macro enregistrée
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

With Sheets("Feuil4")



For i = Range("J65536").End(xlUp).Row To 2 Step -1
If Cells(i, 10).Value = "bb" Or Cells(i, 10).Value = "cc" Or Cells(i, 10).Value = "bb" Or Cells(i, 10).Value = "ee" Or Cells(i, 10).Value = "xx" Or Cells(i, 10).Value = "tt" Or Cells(i, 10).Value = "uu" Or Cells(i, 10).Value = "nn" Or Cells(i, 10).Value = "ll" Then
Cells(i, 2).EntireRow.Delete Shift:=xlUp
End If
Next i


ActiveWindow.SmallScroll ToRight:=3
Range("R6").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-12],0)"
Selection.AutoFill Destination:=Range("R6:R4500")
Range("R6:R4500").Select
Columns("R:R").Select
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Columns("G:G").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 5
ActiveWindow.SmallScroll ToRight:=2
Columns("Z:Z").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("G:G").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 4
ActiveWindow.SmallScroll ToRight:=10
Columns("Z:Z").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("G:G").Select
ActiveSheet.Paste
Range("G6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Feuil1!R[-4]C[2]:R[2494]C[15],14,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-1],Feuil1!R[-4]C[2]:R[2494]C[15],14,0)),0,VLOOKUP(RC[-1],Feuil1!R[-4]C[2]:R[2494]C[15],14,0))"
Range("G6").Select
Selection.AutoFill Destination:=Range("G6:G4500"), Type:=xlFillDefault
Range("G6:G4500").Select
ActiveWindow.ScrollRow = 1

Columns("H:H").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 5
ActiveWindow.SmallScroll ToRight:=10
Columns("Z:Z").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("H:H").Select
ActiveSheet.Paste
Range("H6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Feuil3!R[-4]C[-6]:R[2494]C[-3],4,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-2],Feuil3!R[-4]C[-6]:R[2494]C[-3],4,0)),0,VLOOKUP(RC[-2],Feuil3!R[-4]C[-6]:R[2494]C[-3],4,0))"
Range("H6").Select
Selection.AutoFill Destination:=Range("H6:H4500"), Type:=xlFillDefault
Range("H6:H4500").Select
ActiveWindow.ScrollRow = 1

Columns("I:I").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 5
ActiveWindow.SmallScroll ToRight:=17
Columns("AB:AB").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("I:I").Select
ActiveSheet.Paste
Range("I6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Feuil2!R[-4]C:R[4494]C[10],11,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-3],Feuil2!R[-4]C:R[4494]C[10],11,0)),0,VLOOKUP(RC[-3],Feuil2!R[-4]C:R[4494]C[10],11,0))"
Range("I6").Select
Selection.AutoFill Destination:=Range("I6:I4500"), Type:=xlFillDefault
Range("I6:I4500").Select
ActiveWindow.ScrollRow = 1

Range("V6").Select
ActiveCell.FormulaR1C1 = _
"=1*(SUMPRODUCT(1-ISNA(MATCH(RC[-4]:RC[-3],{15326366;15326550;15310554},0)))>0)"
Selection.AutoFill Destination:=Range("V6:V4500")
Range("V6:V4500").Select
Range("V6").Select
ActiveCell.FormulaR1C1 = _
"=1*(SUMPRODUCT(1-ISNA(MATCH(RC[-4]:RC[-3],{15326366;15326550;15310554},0)))>0)"
Selection.AutoFill Destination:=Range("V6:V4500")
Range("V6:V4500").Select

Range("F4").Select
ActiveCell.FormulaR1C1 = "11"
Range("G4").Select
ActiveCell.FormulaR1C1 = "22"
Range("H4").Select
ActiveCell.FormulaR1C1 = "33"
Range("I4").Select
ActiveCell.FormulaR1C1 = "44"
Range("V4").Select
ActiveCell.FormulaR1C1 = "55"
Range("W4").Select
ActiveCell.FormulaR1C1 = "66"
Range("X4").Select
ActiveCell.FormulaR1C1 = "77"
Range("Y4").Select
ActiveCell.FormulaR1C1 = "88"
Range("U4").Select
ActiveCell.FormulaR1C1 = "99"



Range("W6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]>=1,1,0)"
ActiveWindow.SmallScroll ToRight:=2
Selection.AutoFill Destination:=Range("W6:W4500")
Range("W6:W4500").Select
Range("X6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]>=1,1,0)"
Range("X6").Select
Selection.AutoFill Destination:=Range("X6:X4500")
Range("X6:X4500").Select
Range("Y6").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-19],Feuil3!R[-4]C[-23]:R[2494]C[-15],9,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-19],Feuil3!R[-4]C[-23]:R[2494]C[-15],9,0)),0,VLOOKUP(RC[-19],Feuil3!R[-4]C[-23]:R[2494]C[-15],9,0))"
Range("Y6").Select
Selection.AutoFill Destination:=Range("Y6:Y4500")
Range("Y6:Y4500").Select


With Sheets("Feuil4") à partir de là, ça mouline !!!!
For i = Range("U65536").End(xlUp).Row To 2 Step -1
If Cells(i, 21).Value = "0" Then
Cells(i, 2).EntireRow.Delete Shift:=xlUp

End With
End Sub
 
Trier par date Trier par votes
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Aide macro

Bonjour

peut-être en ajoutant les . (sinon tu peux pointer sur une autre feuille que feuil4)

With Sheets("Feuil4")
For i = .Range("U65536").End(xlUp).Row To 2 Step -1
If .Cells(i, 21).Value = "0" Then
.Cells(i, 2).EntireRow.Delete Shift:=xlUp
next
End With
 
Dernière édition:
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Aide macro

Bonjour
peut-être un retour à la ligne après le then
je te le mets en code, j'aurais dû le faire la première fois

Code: 
With Sheets("Feuil4") 
For i = .Range("U65536").End(xlUp).Row To 2 Step -1
If .Cells(i, 21).Value = "0" Then .Cells(i, 2).EntireRow.Delete Shift:=xlUp
next 
End With
 
Vote positif 0 Vote négatif
B

BRUNO62

XLDnaute Occasionnel
Re : Aide macro

Re,

J'ai appliqué le code, et me donne l'erreur de compil "End Sub attendu"
Même en intégrant "End Sub", l'erreur de compil revient !

Comme tu as pu le constater, je termine la dernière étape par supprimer toutes les lignes doté d'une certaine valeur

C'est peut être là, le "hic".
Personnellement, je ne sais pas !

A+
 
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Aide macro

re

je n'ai testé que ta partie litigieuse

pour moi le code fonctionne

je suis au boulot donc pas trop le temps, fichier joint
 

Pièces jointes

  • efface.xls
    25 KB · Affichages: 38
  • efface.xls
    25 KB · Affichages: 42
  • efface.xls
    25 KB · Affichages: 43
Vote positif 0 Vote négatif
B

BRUNO62

XLDnaute Occasionnel
Re : Aide macro

re,

je sais cela fonctionne par contre c'est quand je lis cette macro à ThisWorkbook

Sub MacroCorrigéEtSimplifié()
' Macro enregistrée
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

With Sheets("Feuil4")



For i = Range("J65536").End(xlUp).Row To 2 Step -1
If Cells(i, 10).Value = "bb" Or Cells(i, 10).Value = "cc" Or Cells(i, 10).Value = "bb" Or Cells(i, 10).Value = "ee" Or Cells(i, 10).Value = "xx" Or Cells(i, 10).Value = "tt" Or Cells(i, 10).Value = "uu" Or Cells(i, 10).Value = "nn" Or Cells(i, 10).Value = "ll" Then
Cells(i, 2).EntireRow.Delete Shift:=xlUp
End If
Next i


ActiveWindow.SmallScroll ToRight:=3
Range("R6").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-12],0)"
Selection.AutoFill Destination:=Range("R6:R4500")
Range("R6:R4500").Select
Columns("R:R").Select
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Columns("G:G").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 5
ActiveWindow.SmallScroll ToRight:=2
Columns("Z:Z").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("G:G").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 4
ActiveWindow.SmallScroll ToRight:=10
Columns("Z:Z").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("G:G").Select
ActiveSheet.Paste
Range("G6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Feuil1!R[-4]C[2]:R[2494]C[15],14,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-1],Feuil1!R[-4]C[2]:R[2494]C[15],14,0)),0,VLOOKUP(RC[-1],Feuil1!R[-4]C[2]:R[2494]C[15],14,0))"
Range("G6").Select
Selection.AutoFill Destination:=Range("G6:G4500"), Type:=xlFillDefault
Range("G6:G4500").Select
ActiveWindow.ScrollRow = 1

Columns("H:H").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 5
ActiveWindow.SmallScroll ToRight:=10
Columns("Z:Z").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("H:H").Select
ActiveSheet.Paste
Range("H6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Feuil3!R[-4]C[-6]:R[2494]C[-3],4,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-2],Feuil3!R[-4]C[-6]:R[2494]C[-3],4,0)),0,VLOOKUP(RC[-2],Feuil3!R[-4]C[-6]:R[2494]C[-3],4,0))"
Range("H6").Select
Selection.AutoFill Destination:=Range("H6:H4500"), Type:=xlFillDefault
Range("H6:H4500").Select
ActiveWindow.ScrollRow = 1

Columns("I:I").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 5
ActiveWindow.SmallScroll ToRight:=17
Columns("AB:AB").Select
Selection.Copy
ActiveWindow.ScrollColumn = 1
Columns("I:I").Select
ActiveSheet.Paste
Range("I6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Feuil2!R[-4]C:R[4494]C[10],11,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-3],Feuil2!R[-4]C:R[4494]C[10],11,0)),0,VLOOKUP(RC[-3],Feuil2!R[-4]C:R[4494]C[10],11,0))"
Range("I6").Select
Selection.AutoFill Destination:=Range("I6:I4500"), Type:=xlFillDefault
Range("I6:I4500").Select
ActiveWindow.ScrollRow = 1

Range("V6").Select
ActiveCell.FormulaR1C1 = _
"=1*(SUMPRODUCT(1-ISNA(MATCH(RC[-4]:RC[-3],{15326366;15326550;15310554},0)))>0)"
Selection.AutoFill Destination:=Range("V6:V4500")
Range("V6:V4500").Select
Range("V6").Select
ActiveCell.FormulaR1C1 = _
"=1*(SUMPRODUCT(1-ISNA(MATCH(RC[-4]:RC[-3],{15326366;15326550;15310554},0)))>0)"
Selection.AutoFill Destination:=Range("V6:V4500")
Range("V6:V4500").Select

Range("F4").Select
ActiveCell.FormulaR1C1 = "11"
Range("G4").Select
ActiveCell.FormulaR1C1 = "22"
Range("H4").Select
ActiveCell.FormulaR1C1 = "33"
Range("I4").Select
ActiveCell.FormulaR1C1 = "44"
Range("V4").Select
ActiveCell.FormulaR1C1 = "55"
Range("W4").Select
ActiveCell.FormulaR1C1 = "66"
Range("X4").Select
ActiveCell.FormulaR1C1 = "77"
Range("Y4").Select
ActiveCell.FormulaR1C1 = "88"
Range("U4").Select
ActiveCell.FormulaR1C1 = "99"



Range("W6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]>=1,1,0)"
ActiveWindow.SmallScroll ToRight:=2
Selection.AutoFill Destination:=Range("W6:W4500")
Range("W6:W4500").Select
Range("X6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-16]>=1,1,0)"
Range("X6").Select
Selection.AutoFill Destination:=Range("X6:X4500")
Range("X6:X4500").Select
Range("Y6").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-19],Feuil3!R[-4]C[-23]:R[2494]C[-15],9,0)"
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-19],Feuil3!R[-4]C[-23]:R[2494]C[-15],9,0)),0,VLOOKUP(RC[-19],Feuil3!R[-4]C[-23]:R[2494]C[-15],9,0))"
Range("Y6").Select
Selection.AutoFill Destination:=Range("Y6:Y4500")
Range("Y6:Y4500").Select

With Sheets("Feuil4")
For i = .Range("U65536").End(xlUp).Row To 2 Step -1
If .Cells(i, 21).Value = "0" Then .Cells(i, 2).EntireRow.Delete Shift:=xlUp
next
End With
 
Vote positif 0 Vote négatif
ERIC S

ERIC S

XLDnaute Barbatruc
Re : Aide macro

Bonjour

juste une question :

si ta macro ne concerne que feuil4 pourquoi la mets-tu dans workbook

quelle que soit la feuille active, un double clic va lancer ta macro et modifier la feuille 4

sauf que tous tes range au lieu de .range, cells au lieu de .cells, risquent, à mon avis de te jouer des tours
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Résolu(e)
XL 2016 VBA dernière cellule vide.
2
Réponses
21
Affichages
2 K
mapomme
mapomme
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
Staple1600
[Excel 365] Nouvelles formules (septembre 2024)
Réponses
0
Affichages
249
Staple1600
Staple1600
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
517
Compte Supprimé 979
C
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
957
job75
job75
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
390
Chaton77
Chaton77
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
962
Nicolas JACQUIN
Nicolas JACQUIN
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
796
fanfan38
fanfan38
Philou0607
  • Question
XL 2016 Erreur 1004 - Erreur définie par l'application ou par l'objet
Réponses
4
Affichages
739
Philou0607
Philou0607
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb

Membres actuellement en ligne

8 membres et 42 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 898
Messages
2 114 011
Membres
112 073
dernier inscrit
dimakhadra