Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

A
  • Résolu(e)
XL 2016 VBA dernière cellule vide.
2
Réponses
21
Affichages
2 K
mapomme
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
448
Compte Supprimé 979
C
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
280
Chaton77
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
780
Nicolas JACQUIN
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
743
fanfan38
  • Question
XL 2016 Erreur 1004 - Erreur définie par l'application ou par l'objet
Réponses
4
Affichages
662
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
  • Question
Microsoft 365 Problème VBA insertion ligne au-desus
Réponses
3
Affichages
606
Mr.Adrien
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
290
marie3107
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…