habiler
04-19-2023, 06:42 AM
Hello everyone,
Code below remove the entire page from B5.
Now in b14 there is the second advancedFiter of which it also erases.
Is it possible to keep the title of the listing in B14:F14 without deleting it (layout title to keep)
How to avoid this?
Thank you in advance
Option Compare Text
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B$2" Then Menu Target
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Set SH1 = [Grades[GrdFull.Grade_all]]
If Target.Address = "$B$2" Then
Sheets("GrdVsFct").Range("B4").CurrentRegion.Offset(4).ClearContents
Sheets("GrdVsFct").Range("B14").CurrentRegion.Offset(14).ClearContents
SH1.CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[B1:B2], CopyToRange:=[B4:J4]
Menu Target
Sheets("GrdVsFct").Range("A2").Formula = "= INDEX(grades[#All],MATCH(B2,grades_FullDen!M:M),5)"
Sheets("Fonctions").[c1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[A1:A2], CopyToRange:=[B14:F14]
End If
End Sub
Sub Menu(cible)
Set F = Sheets("Grades_FullDen")
Set D = CreateObject("Scripting.Dictionary")
Set rng = F.[M1].CurrentRegion.Offset(1)
D("*") = ""
For i = 1 To rng.Rows.Count
clé = rng.Cells(i, 13)
D(clé) = ""
Next i
cible.Validation.Delete
cible.Validation.Add xlValidateList, Formula1:=Join(D.Keys, ",")
End Sub
Code below remove the entire page from B5.
Now in b14 there is the second advancedFiter of which it also erases.
Is it possible to keep the title of the listing in B14:F14 without deleting it (layout title to keep)
How to avoid this?
Thank you in advance
Option Compare Text
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B$2" Then Menu Target
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Set SH1 = [Grades[GrdFull.Grade_all]]
If Target.Address = "$B$2" Then
Sheets("GrdVsFct").Range("B4").CurrentRegion.Offset(4).ClearContents
Sheets("GrdVsFct").Range("B14").CurrentRegion.Offset(14).ClearContents
SH1.CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[B1:B2], CopyToRange:=[B4:J4]
Menu Target
Sheets("GrdVsFct").Range("A2").Formula = "= INDEX(grades[#All],MATCH(B2,grades_FullDen!M:M),5)"
Sheets("Fonctions").[c1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[A1:A2], CopyToRange:=[B14:F14]
End If
End Sub
Sub Menu(cible)
Set F = Sheets("Grades_FullDen")
Set D = CreateObject("Scripting.Dictionary")
Set rng = F.[M1].CurrentRegion.Offset(1)
D("*") = ""
For i = 1 To rng.Rows.Count
clé = rng.Cells(i, 13)
D(clé) = ""
Next i
cible.Validation.Delete
cible.Validation.Add xlValidateList, Formula1:=Join(D.Keys, ",")
End Sub