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 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Private Sub CommandButton1_Click()
Dim Bd As Worksheet
Dim Rech As Worksheet
Dim NbLig As Long
Dim NbCol As Long
Dim Derlign As Integer
Set Bd = ThisWorkbook.Sheets("Gamme")
Set Rech = ThisWorkbook.Sheets("Suivi")
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim l As Integer
Dim Resultat As Variant
j = 1
With Bd
NbLig = .Cells(.Rows.Count, 1).End(xlUp).Row
NbCol = .Cells(1, .Columns.Count).End(xlToRight).Column
End With
For i = 2 To NbLig
If Suivi_gamme.ComboBox1.Value = Bd.Cells(i, 1).Value Then
If Suivi_gamme.ComboBox2.Value = Bd.Cells(i, 2).Value Then
If Suivi_gamme.ComboBox3.Value = Bd.Cells(i, 3).Value Then
For k = 4 To NbCol
If Bd.Cells(i, k).Text Like "Fil" Or Bd.Cells(i, k).Text Like "V22" Or Bd.Cells(i, k).Text Like "Drill 20" Or Bd.Cells(i, k).Text Like "Sodick" Then
If Bd.Cells(i, k + 1).Value = Bd.Cells(i, k).Value Then
Else
Rech.Cells(j + 8, 1).Value = Bd.Cells(1, k).Value
Bd.Cells(i, k).Copy
Rech.Cells(j + 8, 2).PasteSpecial xlPasteValuesAndNumberFormats
j = j + 1
End If
End If
Next k
End If
End If
End If
Next i
For l = 9 To 23
Rech.Range("C" & l).Interior.ColorIndex = xlColorIndexNone
Next l
For l = 9 To 23
If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
Resultat = Application.VLookup(Rech.Cells(4, 2).Value, Workbooks("C:\Users\mto\Desktop\Suivi_Mc_FIL.xlsx").Sheets("2015").Range("C6:J500"), 1, False)
If IsError(Resultat) Then
Rech.Range("C" & l).Interior.ColorIndex = 10
Else
Rech.Range("C" & l).Interior.ColorIndex = 3
End If
End If
Next l
Unload Me
End Sub |
Partager