)
Sub ordre1()
Application.ScreenUpdating = False
Dim u As Byte
Dim i As Integer
Sheets('ordre1').Select
Cells.Select
Selection.Copy
Sheets('1').Select
Cells(1, 1).Select
ActiveSheet.Paste
With Sheets('1')
For i = 1 To Sheets('ordre0').Range('A65000').End(xlUp).Row
For u = 1 To .Range('A65000').End(xlUp).Row
If Sheets('ordre0').Range('D' & i) = .Range('D' & u) And _
Sheets('ordre0').Range('D' & i) = .Range('D' & u) And _
Sheets('ordre0').Range('H' & i) = .Range('H' & u) And _
Sheets('ordre0').Range('J' & i) = .Range('J' & u) And _
Sheets('ordre0').Range('L' & i) = .Range('L' & u) And _
Sheets('ordre0').Range('A' & i) = .Range('A' & u) Then
.Range('D' & u).ActiveCell.EntireRow.Delete
End If
Next u
Next i
supprimeMoins
SelectionCopier1bis
supp
Application.ScreenUpdating = True
End Sub
Sub supp()
Dim i As Integer, j As Byte
Range('B4').Select
For i = Range('A65536').End(xlUp).Row To 2 Step -1
For j = 2 To (Range('IV2').End(xlToLeft).Column - 1) ' Le J ne devrait t_il pas commencer a deux ?
If Cells(i, 2).Value = '***' Then ' Est ce que le ça --> '***' peut se retrouver dans une autre colonnes ? de la même ligne que i ?
Rows(i).Delete
'Cells(i, 2).Select
'j = 1 TU réinitialise le J a 1 pourquoi ?
'k = k + 1 Tu ne fais rien avec ça ???
'Else
' Cells(i, j + 1).Select Tu ne fais rien avec ça ???
End If
Next j
'Cells(i - 1, 2).Select
Next i
End Sub
Option Explicit
Sub supprimeMoins()
Dim derlgn As Integer
derlgn = Range('A65536').End(xlUp).Row
Range(Cells(1, 10), Cells(derlgn, 10)).Select
Selection.Replace What:='-', Replacement:='', LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
Sub SelectionCopier1bis()
Dim X As Integer, Z As Integer
Dim Y As Byte
Application.ScreenUpdating = False
With Worksheets('1')
For X = 1 To Range('A65536').End(xlUp).Row
If .Cells(X, 6) = 'PM7' Then
Z = Worksheets('1bis').Range('A65536').End(xlUp).Row + 1
For Y = 1 To 14
Worksheets('1bis').Cells(Z, Y) = .Cells(X, Y)
Next
End If
Next X
End With
Application.ScreenUpdating = True
End SubSub ordre1()
Dim u, i, j, Col1, Col2 As Integer
Dim ASup As Boolean
Dim derLigneTemp, derLigneCompa As Integer
Dim FeuilTemp As Worksheet
Dim FeuilCompa As Worksheet
ThisWorkbook.Sheets('ordre1').Copy before:=Sheets(1)
ThisWorkbook.Sheets('ordre1 (2)').Name = '1'
Set FeuilTemp = ThisWorkbook.Sheets('1')
Set FeuilCompa = ThisWorkbook.Sheets('ordre0')
'Ici tu fixe les colonnes à tester, la Col1 doit tjs avoir des valeurs et ne pas être vide
Col1 = 1
Col2 = 7
'On recherche la dernière ligne de chaque feuille
i = 1
While FeuilTemp.Cells(i, Col1) <> ''
i = i + 1
Wend
derLigneTemp = i - 1
i = 1
While FeuilCompa.Cells(i, Col1) <> ''
i = i + 1
Wend
derLigneCompa = i - 1
'On trie les données sur la base de la première colonne
FeuilCompa.Range(FeuilCompa.Cells(1, Col1), FeuilCompa.Cells(derLigneCompa, Col2)).Sort Key1:=FeuilCompa.Cells(1, Col1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
FeuilTemp.Range(FeuilTemp.Cells(1, Col1), FeuilTemp.Cells(derLigneTemp, Col2)).Sort Key1:=FeuilTemp.Cells(1, Col1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
i = 1
j = 1
While FeuilTemp.Cells(i, Col1) <> ''
'On revient trois lignes en arrière au cas où. A voir si cela est nécessaire en fonction de tes propres données
If j > 3 Then
j = j - 2
End If
While FeuilCompa.Cells(j, Col1) <> ''
'Hypothèse toutes les données identiques
ASup = True
For u = Col1 To Col2
If FeuilCompa.Cells(j, u) <> FeuilTemp.Cells(i, u) Then
'Données différentes, donc on garde
ASup = False
End If
Next
'Comme toutes les données sont identiques, on zap la boucle
If ASup Then
GoTo suite
End If
j = j + 1
Wend
suite:
If ASup Then
FeuilTemp.Rows(i).Delete
Else
i = i + 1
End If
Wend
Set FeuilCompa = Nothing
Set FeuilTemp = Nothing
End Sub
