1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
| Dim LastLig As Long
'Les données seront copiées à partir de la ligne 8 de la feuille Consultation
LastLig = UsedRange.SpecialCells(xlCellTypeLastCell).Row
If LastLig >= 8 Then
Application.EnableEvents = False
Rows(8 & ":" & LastLig).Clear
Application.EnableEvents = True
End If
'Si la cellule D4 est non vide
If Target.Value <> "" Then
With Sheets("Base")
'On enlève l'éventuel filtre automatique
.AutoFilterMode = False
'la ligne de la dernière cellule remplie de la colonne Col de feuille Base
LastLig = .Cells(.Rows.Count, Col).End(xlUp).Row
'On filtre sur la colonne 1 de la feuille base, en prenant comme critère la valeur de D4 (Target)
.Range("A1:X" & LastLig).AutoFilter Field:=Col, Criteria1:=Target.Value
'On copie les lignes issues du filtre auto (sans la ligne des titres)
If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
.Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Copy Range("A8")
End If
'On enlève notre filtre automatique
.AutoFilterMode = False
End With
End If
End Sub
'Evènement Change de la feuille
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Select Case Target.Address
Case "$D$4": Import 13, Target 'On importe les données de Base dont la Colonne 13 est égale à la valeur de D4
Case "$G$4": Import 12, Target 'On importe les données de Base dont la Colonne 12 est égale à la valeur de G4
End Select
End Sub |
Partager