Sub Copie_Ligne()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Sheets("BaseDeDonnéesGlobal").Activate
Col = "o"
NumLig = 2
With Sheets("BaseDeDonnéesGlobal")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 3 To NbrLig
If .Cells(Lig, Col).Value = "X" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("resultats").Cells(NumLig, 1).Insert Shift:=xlDown
End If
Next
End With
End Sub
Sub Copie_Ligne()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Sheets("BaseDeDonnéesGlobal").Activate
Col = "o"
NumLig = 2
With Sheets("BaseDeDonnéesGlobal")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 3 To NbrLig
If .Cells(Lig, Col).Value = "X" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("resultats").Cells(NumLig, 1).Insert Shift:=xlDown
End If
Next
End With
End Sub
Sub Macro1()
Dim f As Worksheet: Set f = ActiveSheet ' à adapter
f.Range("$A$1:$O$25").AutoFilter Field:=15, Criteria1:="X"
f.AutoFilter.Range.Offset(1, 0).Copy Sheets("Résultats").Cells(Rows.Count, 1).End(xlUp)(2)
f.ShowAllData
End Sub
Sub Macro2()
Dim f As Worksheet: Set f = Sheets("BaseDeDonnéesGlobal")
f.Range("$A$1:$O$25").AutoFilter Field:=15, Criteria1:="X"
'reste ici la plage de cellules à adapter
f.AutoFilter.Range.Offset(1, 0).Copy Sheets("Résultats").Cells(Rows.Count, 1).End(xlUp)(2)
f.ShowAllData
End Sub
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [Tableau1].ListObject.Range 'tableau structuré
.AutoFilter 15, "X"
.SpecialCells(xlCellTypeVisible).Copy [A1]
.AutoFilter
End With
Rows(1).RowHeight = 45
Columns.AutoFit 'ajustement largeur
End Sub
Sub Macro3()
Dim f As Worksheet: Set f = Sheets("BaseDeDonnéesGlobal")
f.Cells(1).CurrentRegion.AutoFilter 15, "X"
f.AutoFilter.Range.Offset(1, 0).Copy Sheets("Résultats").Cells(Rows.Count, 1).End(xlUp)(2)
f.ShowAllData
End Sub