ou est mon erreur

[Bricoltou]

Bonsoir le Fil
Pouvez vous m'aider à trouver mon erreur ?
dans le fichier ci joint j'ai mis un code pour comparer deux colonnes ,il fonctionne bien .
Les deux onglets sont réellement deux fichiers séparés ,j'ai essayé de l'adapter mais il bloque sur la ligne bleu:
Merci d'avance pour votre aide
Voici mon code
Private Sub CdButOK_Click()
Dim i As Long, j As Long, plagehebdo As Range, plagejour As Range
Select Case CbBox_choixjour.Value
Case "Lundi"
'Workbooks.Open Filename:= _
'"K:\Pilotage\Camionnage\Matrice_Chauffeur.xls"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Desktop\Camionnage\Heures_chauffeurs.xls"
Sheets("Hebdo").Select
ActiveSheet.Unprotect Password:="Terminal"
Set plagehebdo = Sheets("Hebdo").Range("A6:A" & Range("A65356").End(xlUp).Row)
For Each nom1 In plagehebdo
i = nom1.Row
heure1 = Sheets("Hebdo").Range("C" & i)
heure1 = Format(heure1, "hh:mm")
'Workbooks.Open Filename:= _
'"K:\Pilotage\Camionnage\Matrice_Chauffeur.xls"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Desktop\Camionnage\Matrice_chauffeur.xls"
Sheets("Lundi").Select
ActiveSheet.Unprotect Password:="Terminal"
Set plagejour = Sheets("Lundi").Range("B3:B" & Range("B65356").End(xlUp).Row)
For Each nom2 In plagejour
plagejour.Select
j = nom2.Row
heure2 = Sheets("Lundi").Range("U" & j)
heure2 = Format(heure2, "hh:mm")
If nom1 = nom2 And heure1 <> heure2 Then
Range("U" & j).Interior.ColorIndex = 6 'Colorie en Jaune la cellule
Exit For
End If
Next nom2

Sheets("Lundi").Select

Next nom1
End Select
End Sub

@+
Bricoltou

 

[job75]

Re : ou est mon erreur

Bonsoir Bricoltou, le fil,

L'utilisation de Select Case n'est pas ici la bonne solution, il vaut mieux une boucle :

Private Sub CommandButton1_Click()
Dim F1 As Worksheet, F2 As Worksheet, plagehebdo As Range, plagejour As Range
Dim i As Byte, nom1 As Range, nom2 As Range, heure1, heure2
Application.ScreenUpdating = False

On Error Resume Next
Workbooks.Open Filename:=ThisWorkbook.Path & "\Bricoltou.xls"
Set F1 = Workbooks("Bricoltou.xls").Sheets("semaine")
If F1 Is Nothing Then Exit Sub ' si le fichier ou la feuille n'existent pas
Set plagehebdo = F1.Range("A6:A" & F1.Range("A65536").End(xlUp).Row)
  
Workbooks.Open Filename:=ThisWorkbook.Path & "\Bricoltou1.xls"
[COLOR="Red"]For i = 3 To 8 'boucle sur les 6 jours de la semaine[/COLOR]

Set F2 = Workbooks("Bricoltou1.xls").Sheets([COLOR="red"]F1.Cells(4, i).Text[/COLOR])
If F2 Is Nothing Then GoTo 1
F2.Unprotect Password:="Terminal"
Set plagejour = F2.Range("B3:B" & F2.Range("B65356").End(xlUp).Row)
F2.Range("U3:U65536").Interior.ColorIndex = xlNone 'efface les couleurs

For Each nom1 In plagehebdo
  heure1 = Format([COLOR="Red"]F1.Cells(nom1.Row, i)[/COLOR]), "hh:mm")
  For Each nom2 In plagejour
    heure2 = Format(F2.Cells(nom2.Row, "U"), "hh:mm")
    If nom1 = nom2 And heure1 <> heure2 Then
      F2.Cells(nom2.Row, "U").Interior.ColorIndex = 6 'Colorie en Jaune la cellule
      Exit For
    End If
  Next nom2
Next nom1

F2.Protect Password:="Terminal"
[COLOR="red"]1 Next i[/COLOR]

ThisWorkbook.Activate
End Sub

Bonne nuit et A+

 

[Bricoltou]

Re : ou est mon erreur

Bonsoir Le Fil,Job75

Job75,merci encore pour ton aide le fichier fonctionne parfaitement 😛

j'espère pouvoir aider les autres un jour .

@+

Bricoltou