Sub Trie_()
Dim dlAD As Long, dlAR As Long, dlBC As Long, cell_vide As Long, C1 As Integer
Dim dl_A As Long ' nombre total de cellules dans la colonne A
' C1 donne le nombre de cellules en A qui commencent par bien par les 2 premiers données en liste feuil 2 Colonne A
' Je vide les colonnes pour ne pas avoir des restes d'anciens imports et ne conserver que mes 2 colonnes a traiter
Sheets("Feuil1").Columns("c:bd") = Empty
'On supprime les = et les espaces
Sheets("Feuil1").Range("a:b").Replace What:="=", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("Feuil1").Range("a:b").Replace What:=" ", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Application.ScreenUpdating = False ' je desactive l'affichage pour gagner du temps
'On convertit la colonne A pour separer les données si des espaces sont présent
Sheets("Feuil1").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
'on trie avant la copie pour gagner du temps
Sheets("Feuil1").Columns("a:b").Select
Range("a1").Activate
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
"a1:a31170"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("a1:b31170")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$a$1:$b$31170").RemoveDuplicates Columns:=1, Header:= _
xlNo
' ici je trie les données dont les 2 premières lettres ne sont pas dans ma liste en A1 sur feuil 2
dl_A = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
Range("C1:C" & dl_A).FormulaR1C1 = "=IF(or(LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A1") & ",LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A2") & ",LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A3") & ",LEFT(RC[-2],2)=" & Sheets("Feuil2").Range("A4") & "),""OK"",""Pas Ok"")"
Range("c1:c" & dl_A).Select
Selection.Copy
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C" & dl_A), Type:=xlFillDefault
Range("C1:C" & dl_A).Select
Columns("A:C").Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
"C1:C" & dl_A), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A1:C" & dl_A)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("c:c").Select
Selection.Copy
Range("c1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
C1 = WorksheetFunction.CountIf(Sheets("Feuil1").Columns("C"), "OK")
MsgBox C1
If C1 <> dl_A Then
Range("a" & C1 + 1 & ":c" & dl_A + 1) = Empty
End If
'je met juste le nombre de cellule en msgbox pour verifier le calcul
End Sub