Bonjour,
J'ai mon code d'extraction qui fait bien le taf le seul soucis c'est que sur ma feuille ou les données extraite s'affichent je n'arrive pas à garder les entêtes, elles s'effacent automatiquement dés que je fais une extraction et autre soucis le tableau, d'où les données sont extraites, se filtre automatiquement du coup je doit retirer le filtre après chaque extraction si je veux voir mon tableau complet![Face with spiral eyes :face_with_spiral_eyes: 😵💫](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f635-1f4ab.png)
Voici le code si quelqu'un vois l'erreur ou la modification à apporter![Mains pliées :pray: 🙏](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f64f.png)
Option Explicit
Sub RectangleExtract_Cliquer()
Dim Nblg As Long
Sheets("Liste Agents").Activate
ActiveSheet.Unprotect Password:="****"
Application.ScreenUpdating = False
Nblg = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:F" & Nblg).AutoFilter field:=4, Criteria1:="EAP"
If Application.Subtotal(103, Range("A2:F" & Nblg)) > 0 Then
With Sheets("EXTRACT")
.Cells.Clear
Range("A3:F" & Nblg).SpecialCells(xlCellTypeVisible).Copy .Range("A3")
.Range("A1:Y" & .Range("B" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=3
End With
ActiveSheet.Protect Password:="****"
ActiveSheet.AutoFilterMode = False
Sheets("EXTRACT").Activate
End If
End Sub
Merci d'avance![Visage rayonnant aux yeux souriants :grin: 😁](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f601.png)
J'ai mon code d'extraction qui fait bien le taf le seul soucis c'est que sur ma feuille ou les données extraite s'affichent je n'arrive pas à garder les entêtes, elles s'effacent automatiquement dés que je fais une extraction et autre soucis le tableau, d'où les données sont extraites, se filtre automatiquement du coup je doit retirer le filtre après chaque extraction si je veux voir mon tableau complet
![Face with spiral eyes :face_with_spiral_eyes: 😵💫](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f635-1f4ab.png)
Voici le code si quelqu'un vois l'erreur ou la modification à apporter
![Mains pliées :pray: 🙏](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f64f.png)
Option Explicit
Sub RectangleExtract_Cliquer()
Dim Nblg As Long
Sheets("Liste Agents").Activate
ActiveSheet.Unprotect Password:="****"
Application.ScreenUpdating = False
Nblg = Range("A" & Rows.Count).End(xlUp).Row
Range("A1:F" & Nblg).AutoFilter field:=4, Criteria1:="EAP"
If Application.Subtotal(103, Range("A2:F" & Nblg)) > 0 Then
With Sheets("EXTRACT")
.Cells.Clear
Range("A3:F" & Nblg).SpecialCells(xlCellTypeVisible).Copy .Range("A3")
.Range("A1:Y" & .Range("B" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=3
End With
ActiveSheet.Protect Password:="****"
ActiveSheet.AutoFilterMode = False
Sheets("EXTRACT").Activate
End If
End Sub
Merci d'avance
![Visage rayonnant aux yeux souriants :grin: 😁](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f601.png)