XL 2019 Explications du code

MJD001

XLDnaute Nouveau
bonjour le forum!!!! j'ai besoin votre aide pour m'expliquer par des commentaires le code que je vais joindre en dessous

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range, Q As Range, R As Range
Application.ScreenUpdating = False
With Sheets("BASE").[A1].CurrentRegion
Set P = .Columns(1).Resize(, 3) '3 premières colonnes
Set Q = .Rows(1).Find(Sh.Name, , xlValues, xlWhole) 'recherche de X ou Y
If Q Is Nothing Then Exit Sub
Set Q = Intersect(.Cells, Q.MergeArea.EntireColumn) 'colonnes X ou Y
Set R = Q.Columns(1).SpecialCells(xlCellTypeConstants).EntireRow 'filtrage
Sh.Cells.Delete 'EAZ
Intersect(Union(P, Q), R).Copy Sh.[A1] 'copier-coller
'---mises en forme---
With Sh.UsedRange
Union(.Columns(7), .Columns(9), .Columns(10)).Delete xlToLeft 'colonnes inutiles
Set P = .Rows(2).Resize(Application.Max(.Rows.Count - 1, 2))
Sh.ListObjects.Add(xlSrcRange, P, , xlYes).Name = "Tableau" & Sh.Name 'création du tableau structuré
.Columns.AutoFit 'largeurs des colonnes
End With
End With
End Sub
 

vgendron

XLDnaute Barbatruc
bonjour
pourquoi ne pas demander à l'auteur du code?

VB:
Option Explicit 'oblige à déclarer TOUTES les variables utilisées dans la macro

Private Sub Workbook_SheetActivate(ByVal Sh As Object) 'évèneement activate de la feuille dans laquelle ce code est mis==> à chaque fois que la feuille sera activée, le code est executé
Dim P As Range, Q As Range, R As Range 'définition des 3 variables P, Q R
Application.ScreenUpdating = False 'désactivation du refresh de l'écran: pour accélerer l'exectution
With Sheets("BASE").[A1].CurrentRegion 'dans la feuille BASE, travaille sur la zone autour de A1 (équivaut à un Ctrl+A)
Set P = .Columns(1).Resize(, 3) '3 premières colonnes
Set Q = .Rows(1).Find(Sh.Name, , xlValues, xlWhole) 'recherche de X ou Y
If Q Is Nothing Then Exit Sub 'si le nom de la feuille Sh n'est pas trouvé==> quitte la macro
Set Q = Intersect(.Cells, Q.MergeArea.EntireColumn) 'colonnes X ou Y
Set R = Q.Columns(1).SpecialCells(xlCellTypeConstants).EntireRow 'filtrage
Sh.Cells.Delete 'EAZ
Intersect(Union(P, Q), R).Copy Sh.[A1] 'copier-coller
'---mises en forme---
With Sh.UsedRange
Union(.Columns(7), .Columns(9), .Columns(10)).Delete xlToLeft 'colonnes inutiles
Set P = .Rows(2).Resize(Application.Max(.Rows.Count - 1, 2))
Sh.ListObjects.Add(xlSrcRange, P, , xlYes).Name = "Tableau" & Sh.Name 'création du tableau structuré
.Columns.AutoFit 'largeurs des colonnes
End With
End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 783
Membres
101 817
dernier inscrit
carvajal