XL 2016 Optimisation MACROS

Michest94 · 5 Janvier 2021

Bonjour,

Je vous sollicite pour votre aide afin d'optimiser 3 fichiers, un fichier 'Interventions' (cf fichier joint) qui me permet d'extraire des données en brut.
Puis après une remise en forme de ces données, elles vont être exportées vers un logiciel tiers ( powerBI ).
Actuellement tout fonctionne mais une partie des macros ont été réalisées avec l'enregistreur de macros d'où des latences ...

Une optimisation sur optimisation sur partie codifié en gras :

module 1 pour le bouton RAZ
Sub RAZ()
Sheets("Extract_Inters").Range("A2:Z10000").ClearContents
Sheets("InterA").Range("A2:Z10000").ClearContents
Sheets("InterN").Range("A2:Z10000").ClearContents
Sheets("Extraction données INTER").Activate
Range("A2:M10000").ClearContents
Range("A1").Select
End Sub

module 2 la partie
'
' *** Niveau ARBO (fils vers père) ***
'
'Traitement colonne G
Columns("O:O").Select
Selection.ClearContents
Columns("G:G").Select
Selection.Copy
Columns("O:O").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("P").Select
Application.CutCopyMode = False
Selection.Copy
Columns("G:G").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("O:O").Select
'Selection.ClearContents
Columns("G:G").EntireColumn.AutoFit

Module 4 ( optimisation complète )

Merci pour votre aide,

*******************************************************************************************
Eventuellement dans le même but j'ai 2 autres fichiers à optimiser 'DI' et 'Occupations'
optimisation sur partie codifié en gras
*******************************************************************************************

***Fichier 'DI'***
Module 1

Option Explicit

Dim w1 As Workbook, f1 As Worksheet, liste1, liste2
Dim i&, j&, lgn&, flag&
Sub RAZ()
Sheets("Extract_DI").Range("A2:Z10000").ClearContents
Sheets("Infos DI").Range("A2:H10000").ClearContents
End Sub

Sub Recuperer()
[Extract_DI!2:65536].EntireRow.Delete
flag = 0
For Each w1 In Workbooks
For Each f1 In w1.Worksheets
If w1.Name <> ActiveWorkbook.Name Then
If f1.Range("A1") = "Destinataire de la DI" Then
liste1 = Array(6, 3, 7, 13, 4, 1, 18)
liste2 = Array(1, 2, 3, 4, 5, 6, 7)

For i = 2 To f1.Range("A" & Rows.Count).End(xlUp).Row
lgn = Range("A" & Rows.Count).End(xlUp)(2).Row
For j = 0 To 6
If j = 0 Then
Cells(lgn, liste2(j)).Value = CDate(f1.Cells(i, liste1(j)).Value)
Else
Cells(lgn, liste2(j)).Value = f1.Cells(i, liste1(j)).Value
End If
Cells(lgn, 1).NumberFormat = "[$-fr-FR]mmm-yy;@"
Next j
Next i
flag = 1
End If

End If
Next f1
Next w1
If flag = 0 Then
MsgBox "Le fichier source doit être ouvert.", 16
Exit Sub
End If

'
' Traitement A - HA
'

'
Sheets("A-HA").Select
Range("A2").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Columns("A:B").Select
Selection.Copy
Sheets("Extract_DI").Select
Columns("L:M").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

'
' TRI numéros interventions A-Z colonne B et L
'

'
Range("B2").Select
ActiveWorkbook.Worksheets("Extract_DI").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Extract_DI").Sort.SortFields.Add Key:=Range( _
"B2:B303"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Extract_DI").Sort
.SetRange Range("A1:H10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("L1:M1").Select
Selection.AutoFilter
Selection.AutoFilter
ActiveWorkbook.Worksheets("Extract_DI").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Extract_DI").AutoFilter.Sort.SortFields.Add Key:= _
Range("L1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Extract_DI").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select

'
' Copie Astreinte colonne M vers colonne H
'

'
Columns("M:M").Select
Selection.Copy
Columns("H:H").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
End Sub

Module 2 ->ok

Module 3
Sub PowerBI_DI()
'
' PowerBI_DI Macro
'

'
Cells.Select
Selection.Copy
Sheets("Infos DI").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Extract_DI").Select
Range("A1").Select
Application.CutCopyMode = False

Columns("A:A").Select
Selection.Copy
Sheets("Infos DI").Select
Columns("A:A").Select
ActiveSheet.Paste
Sheets("Extract_DI").Select
Range("A1").Select
Application.CutCopyMode = False
End Sub

***Fichier 'Occupations'***
Module 1

Option Explicit

Dim w As Workbook
Dim flag&, colA, colB, l&
Sub RAZ()
Sheets("Extraction données OCCU").Range("A2:Z10000").ClearContents
Sheets("OccuN").Range("A2:H10000").ClearContents
Sheets("OccuA").Range("A2:H10000").ClearContents
End Sub
Sub Importer()

flag = 0
Range("A1").CurrentRegion.Offset(1, 0).ClearContents
For Each w In Workbooks
If w.Sheets(1).Range("B1") = "Libellé" Then
colA = Array(10, 15, 8, 3, 17, 2, 5)
colB = Array(1, 2, 3, 4, 5, 6, 7)
With w.Sheets(1)
For l = 0 To 6
.Range(.Columns(colA(l)), .Columns(colA(l))).Copy Cells(1, colB(l))
Next l
End With
flag = 1
Exit For
End If
Next w
If flag = 0 Then
MsgBox "Le fichier source doit être ouvert.", 16
End If

'
' RAZ_OccuA_HA Macro
'

'
Sheets("OccuA").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("OccuN").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Extraction données OCCU").Select

End Sub

Module 2 -> ok

Module 3
Sub OccuA()
'
' OccuA Macro
'

'
ActiveSheet.Range("$A$1:$G$65536").AutoFilter Field:=3, Criteria1:=Array( _
"ASTR_DIST_PAYE", "ASTR_DIST_RECUP", "ASTR_SPLACE_PAYE", "ASTR_SPLACE_RECUP"), _
Operator:=xlFilterValues
Cells.Select
Selection.Copy
Sheets("OccuA").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Extraction données OCCU").Select
ActiveSheet.Range("$A$1:$G$65536").AutoFilter Field:=3
Range("A1").Select
'Application.CutCopyMode = False
End Sub
Sub OccuHA()
'
' OccuHA Macro
'

'
ActiveSheet.Range("$A$1:$G$65536").AutoFilter Field:=3, Criteria1:=Array( _
"NORMAL", "SUPP_PAYE", "SUPP_RECUPE"), Operator:=xlFilterValues
Cells.Select
Selection.Copy
Sheets("OccuN").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Range("A1").Select
Sheets("Extraction données OCCU").Select
ActiveSheet.Range("$A$1:$G$65536").AutoFilter Field:=3
Range("A1").Select
Application.CutCopyMode = False
End Sub

Robert · 5 Janvier 2021

Bonjour Michest, bonjour le forum,

Bon... On va y aller par étapes....

• Module1
je ne vois rien à modifier

• Module 2
Règle d'or VBA : éviter autant que possible les Select/Activate qui ne font que ralentir l'exécution du code et sont source de plantages :

Code:

Dim OE As Worksheet

Set OE = Worksheets("Extraction données INTER")
OE.Columns("O:O").ClearContents
OE.Columns("G:G").Copy
OE.Columns("O:O").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
OE.Columns("P:P").Copy
OE.Columns("G:G").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
OE.Columns("G:G").AutoFit

Pour le reste suivre la règle...

Michest94 · 6 Janvier 2021

Michest à dit:
Bonsoir,

J'extrais des données brut d'une GMAO (Karl)
Que je remet en forme avec EXCEL et que j'importe dans PowerBI afin d'en tirer des bilans.
Regarde la pièce jointe 1090873

exporte

Michest94 · 6 Janvier 2021

Michest à dit:
Autant pour moi reste que le module 4

Rectif sur module 1
En fait il m'efface les colonnes N,O,P sachant que la colonne N est une base et O,P une comparaison par rapport à cette base.

laurent950 · 6 Janvier 2021

Re @Michest
Merci pour cet info, je ne connaissais pas powerBI

Staple1600 · 7 Janvier 2021

Re

=>Michest
Si tu parles du code que j'ai posté, je suis parti de la plage de cellules indiquée dans le poste#1 : A1:Z10000
Il suffit d'adapter la plage quand on appelle la macro Effacer
Donc A2:M10000

Staple1600 · 7 Janvier 2021

Re

Pour le module 2, en théorie, le résultat doit être identique à la macro originale.

VB:

Sub mColonneG()
'Traitement colonne G
Dim dl&
dl = Cells(Rows.Count, "G").End(3).Row
Application.ScreenUpdating = False
Range("O1:O" & dl) = Range("G1:G" & dl).Value
Range("G1:G" & dl) = Range("P1:P" & dl).Value
Columns("G:G").EntireColumn.AutoFit
End Sub

Michest94 · 7 Janvier 2021

Staple1600 à dit:
Re

=>Michest
Si tu parles du code que j'ai posté, je suis parti de la plage de cellules indiquée dans le poste#1 : A1:Z10000
Il suffit d'adapter la plage quand on appelle la macro Effacer
Donc A2:M10000

Bonjour staple1600,

J'y comprends plus rien!

En vert mon ancien code avec pour la feuille Extract_inter "A2 : Z1000" cela fonctionne et ne m'efface pas les colonnes N,P,O et tant mieux mais curieux par rapport à la zone sélectionner.
Alors qu'avec ta macro cela m'efface N,B,0 alors que la zone sélectionner est bien "A2:M1000"...

Michest94 · 7 Janvier 2021

Michest à dit:
Bonjour staple1600,

J'y comprends plus rien!

Regarde la pièce jointe 1090893

En vert mon ancien code avec pour la feuille Extract_inter "A2 : Z1000" cela fonctionne et ne m'efface pas les colonnes N,P,O et tant mieux mais curieux par rapport à la zone sélectionner.
Alors qu'avec ta macro cela m'efface N,B,0 alors que la zone sélectionner est bien "A2:M1000"...

Si pour le module 4 je tombe sur ce genre de mystère je pense que l'optimisation du code va rester avec du VBA fait avec l'enregistreur ...

laurent950 · 7 Janvier 2021

Bonjour @Michest
Module 1

VB:

Sub RAZ()
Dim T() As Variant
Dim ObjRaz As Range
Dim i As Byte
    T = Array("Extract_Inters", "InterA", "InterN", "Extraction données INTER")
    For i = LBound(T) To UBound(T)
        Set T(i) = Worksheets(T(i))
        If i < 3 Then
            Set ObjRaz = T(i).Range("A2:Z10000"): ObjRaz.ClearContents
        Else
            Set ObjRaz = T(i).Range("A2:M10000"): ObjRaz.ClearContents
        End If
    Next i
End Sub

Module 2

VB:

'   Traitement colonne G
    Dim RgnOO As Range
        Set RgnOO = Range("O:O")
    Dim RgnGG As Range
        Set RgnGG = Range("G:G")
    Dim RgnPP As Range
        Set RgnPP = Range("P:P")
    RgnOO.ClearContents
    RgnGG.Copy: RgnOO.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
    RgnPP.Copy: RgnGG.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
    RgnGG.EntireColumn.AutoFit
    Application.CutCopyMode = False

Le sous détaille de la modification du module 2 :
avec cela vous pouvez déjà en optimisé d'autres passage de votre Projet VBA

VB:

'Traitement colonne G
dim RgnOO as range
    set RgnOO = Range("O:O")
dim RgnGG as range
    set RgnGG = Range("G:G")
dim RgnPP as range
    set RgnPP = Range("P:P")
'
'Columns("O:O").Select :Selection.ClearContents
    RgnOO.ClearContents
'Columns("G:G").Select :Selection.Copy
'Columns("O:O").Select
'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
'SkipBlanks:=False, Transpose:=False 
    RgnGG.Copy :RgnOO.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
'Columns("P:p").Select
'Application.CutCopyMode = False
'Selection.Copy
'Columns("G:G").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
    RgnPP.Copy :RgnGG.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
'Columns("O:O").Select
'Selection.ClearContents

VB:

[B]' Copie Astreinte colonne M vers colonne H[/B]
dim RgnMM as range
    set RgnMM = Range("M:M")
dim RgnHH as range
    set RgnHH = Range("H:H")
    RgnMM.Copy :RgnHH.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
Columns("G:G").EntireColumn.AutoFit
RgnGG.EntireColumn.AutoFit

Michest94 · 7 Janvier 2021

laurent950 à dit:

Bonjour @Michest
Module 1

VB:

Sub RAZ()
Dim T() As Variant
Dim ObjRaz As Range
Dim i As Byte
    T = Array("Extract_Inters", "InterA", "InterN", "Extraction données INTER")
    For i = LBound(T) To UBound(T)
        Set T(i) = Worksheets(T(i))
        If i < 3 Then
            Set ObjRaz = T(i).Range("A2:Z10000"): MsgBox ObjRaz.ClearContents
        Else
            Set ObjRaz = T(i).Range("A2:M10000"): MsgBox ObjRaz.ClearContents
        End If
    Next i
End Sub

Module 2

VB:

'   Traitement colonne G
    Dim RgnOO As Range
        Set RgnOO = Range("O:O")
    Dim RgnGG As Range
        Set RgnGG = Range("G:G")
    Dim RgnPP As Range
        Set RgnPP = Range("P:P")
    RgnOO.ClearContents
    RgnGG.Copy: RgnOO.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
    RgnPP.Copy: RgnGG.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
    RgnGG.EntireColumn.AutoFit
    Application.CutCopyMode = False

Le sous détaille de la modification du module 2 :
avec cela vous pouvez déjà en optimisé d'autres passage de votre Projet VBA

VB:

'Traitement colonne G
dim RgnOO as range
    set RgnOO = Range("O:O")
dim RgnGG as range
    set RgnGG = Range("G:G")
dim RgnPP as range
    set RgnPP = Range("P:P")
'
'Columns("O:O").Select :Selection.ClearContents
    RgnOO.ClearContents
'Columns("G:G").Select :Selection.Copy
'Columns("O:O").Select
'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
'SkipBlanks:=False, Transpose:=False   
    RgnGG.Copy :RgnOO.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
'Columns("P:p").Select
'Application.CutCopyMode = False
'Selection.Copy
'Columns("G:G").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
    RgnPP.Copy :RgnGG.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
'Columns("O:O").Select
'Selection.ClearContents
Columns("G:G").EntireColumn.AutoFit
RgnGG.EntireColumn.AutoFit

Bonjour Laurent950,

Merci pour ton retour d'infos,
J'ai testé pour l'instant que le module1 et j'ai cette fenêtre qui apparait 3 fois avant le RAZ puis ca mouline.
Je vais regardé le module 2 et te ferais un retour plus en début de soirée.
Concernant le module 4 lié au bouton rouge (3-PowerBI) je vais essayé d'adapter le vba comme dans le module 2 car c'est lui qui demande le plus de calculs et créer la lenteur du programme...

laurent950 · 7 Janvier 2021

Re @Michest

Oui j'ai Oublier de desactiver la Msgbox
MsgBox ObjRaz.ClearContents ---- Replacer par ----->> ObjRaz.ClearContents

J'ai créer une procédure pour effacer bien plus rapides :
[{"Extract_Inters","A2:Z10000"}]
Nom de la Feuille Excel = "Extract_Inters"
Plage a effacer = "A2:Z10000"
Il suffit juste de remplire dans la variable tableau T pour chacunes des feuilles la plage a effacer :
Exemple 1 : Pour la Feuille excel (Nom F1)
T = Array([{"F1","A2:C40"}], [{"F1","W3:Z1087"}], [{"F1","E32:J80"}],
Exemple 1 : Pour la Feuille excel (Nom F1 et F2 et F3)
T = Array([{"F1","A2:C40"}], [{"F2","W3:Z1087"}], [{"F3","E32:J80"}],
La procédure de la boucle la variable i est instancier a Byte soit 0 à 255
255 Plage c'est déjà pas mal ! une plage de la Feuil c'est l'adresse : "A2:C40"
A tester est adaptable à convenance.

module 1 pour le bouton RAZ

VB:

Sub RAZ()
Dim T As Variant
T = Array([{"Extract_Inters","A2:Z10000"}], [{"InterA","A2:Z10000"}], [{"InterN","A2:Z10000"}], [{"Extraction données INTER","A2:M10000"}])
RAZSelect T
'Sheets("Extract_Inters").Range("A2:Z10000").ClearContents
'Sheets("InterA").Range("A2:Z10000").ClearContents
'Sheets("InterN").Range("A2:Z10000").ClearContents
'Sheets("Extraction données INTER").Activate
'Range("A2:M10000").ClearContents
'Range("A1").Select
End Sub

'
et
'

VB:

Sub RAZ()
Dim T As Variant
T = Array([{"Extract_DI","A2:Z10000"}], [{"Infos DI","A2:H10000}])
RAZSelect T
'Sheets("Extract_DI").Range("A2:Z10000").ClearContents
'Sheets("Infos DI").Range("A2:H10000").ClearContents
End Sub

'
et
'

VB:

Sub RAZ()
Dim T As Variant
T = Array([{"Extraction données OCCU","A2:H10000"}], [{"OccuA","A2:H10000}])
RAZSelect T
'Sheets("Extraction données OCCU").Range("A2:Z10000").ClearContents
'Sheets("OccuN").Range("A2:H10000").ClearContents
'Sheets("OccuA").Range("A2:H10000").ClearContents
End Sub

'
' Procédure RAZSelect
'
' Crer une Fonction

VB:

Sub RAZSelect(ByRef T As Variant)
Dim F As Worksheet
Dim ObjRaz As Range
Dim i As Byte
    For i = LBound(T) To UBound(T)
        Set F = Worksheets(CStr(T(i)(1)))
        Set ObjRaz = F.Range(CStr(T(i)(2)))
        ObjRaz.ClearContents
    Next i
End Sub

Staple1600 · 7 Janvier 2021

Bonsoir le fil,

Michest à dit:
Bonjour staple1600,

J'y comprends plus rien!

Regarde la pièce jointe 1090893

En vert mon ancien code avec pour la feuille Extract_inter "A2 : Z1000" cela fonctionne et ne m'efface pas les colonnes N,P,O et tant mieux mais curieux par rapport à la zone sélectionner.
Alors qu'avec ta macro cela m'efface N,B,0 alors que la zone sélectionner est bien "A2:M1000"...

Effectivement, il y avait un petit souci
Ci-dessous, une macro juste explicative (A TESTER SUR UN CLASSEUR VIERGE, avec 3 feuilles: Feuil1, Feuil2 et Feuil3)
Juste pour voir comment cela fonctionne
Il faut d'abord lancer la macro Créér_Test()
NB: J'espère que les commentaires sont suffisamment claires.

VB:

Dim f As Workbook
Sub Créer_TEST()
Feuil1.Range("A1:C10") = "=ADDRESS(ROW(),COLUMN(),4)"
Feuil1.Range("A1:C3").Interior.ColorIndex = 20
Feuil2.Range("A1:C25") = "=COS(COLUMN()+ROW())"
Feuil2.Range("A1:B5").Interior.ColorIndex = 12
Feuil3.Range("A1:E10") = "=ROW()^COLUMN()"
Feuil3.Range("A1:C3").Interior.ColorIndex = 6
End Sub
Sub RAZ()
'ici on effacera la plage A1:C3 des feuilles Feuil1 et Feuil3
Effacer "A1:C3", "Feuil1", "Feuil3"
'ici on effacera la plage A1:B5 de la feuille Feuil2
Effacer "A1:B5", "Feuil2"
End Sub

Private Sub Effacer(r As String, ParamArray vF() As Variant)
Set f = ThisWorkbook
If UBound(vF) < 0 Then Exit Sub
f.Sheets(vF).Select: Range(r).Select: Selection.ClearContents: f.Sheets(vF(0)).Select
End Sub

Staple1600 · 7 Janvier 2021

re

Donc une fois, le test OK, tu sauras comment adapter la syntaxe en indiquant les plages de cellules à traiter et le nom des feuilles concernées.
Et cette fois-ci, cela devrait fonctionner correctement sur ton vrai fichier.

Staple1600 · 7 Janvier 2021

Bonsoir

C'est une coquetterie d'écriture.
Cela semble fonctionner ainsi

VB:

Private Sub Effacer(r As String, ParamArray vF() As Variant)
If UBound(vF) < 0 Then Exit Sub
Sheets(vF).Select: Range(r).Select: Selection.ClearContents: Sheets(vF(0)).Select
End Sub

Mais il peut y avoir des effets de bord.
Si par exemple, il y a deux classeurs ouverts avec également 3 feuilles nommées Feuil1, Feuil2 et Feuil3
Donc finalement, je garde mon petit f

Staple1600 · 7 Janvier 2021

Re

=>Laurent950
Si cela fonctionne, sinon je n'aurai pris la peine de poster un macro pour créer les conditions du test...
Tu as fait le test du message#26?
Moi, oui !

Staple1600 · 7 Janvier 2021

Re

Ne pas oublier que mon code sent la pomme (enfin mapomme )

Il te reste plus qu'à effacer ton précédent message qui contient de la fake news comme dirait Donald

XL 2016 Optimisation MACROS

Michest94

XLDnaute Occasionnel

Pièces jointes

Robert

Michest94

XLDnaute Occasionnel

Michest94

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Michest94

XLDnaute Occasionnel

Michest94

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

Michest94

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires