XL 2019 Explications du code

[MJD001]

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]

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

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