On Error Resume Next
Dim X As Worksheet
Dim k As Integer
Dim m As Date
Dim n As Date
ListBox1.Clear
rng1 = CDate(TextBox9.Value)
rng2 = CDate(TextBox10.Value)
rng3 = ComboBox1.Text
rng4 = ComboBox2.Text
dfr = 0
For Each X In ThisWorkbook.Worksheets
ss = X.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To ss
If X.Cells(i, 6) Like "*" & rng3 & "*" And X.Cells(i, 4) Like "*" & rng4 & "*" And X.Cells(i, 2) >= rng1 And X.Cells(i, 2) <= rng2 Then
ListBox1.AddItem
ListBox1.List(dfr, 0) = X.Cells(i, 1)
ListBox1.List(dfr, 1) = Format(X.Cells(i, 2), "dd/mm/yyyy")
ListBox1.List(dfr, 2) = X.Cells(i, 3)
ListBox1.List(dfr, 3) = X.Cells(i, 4)
ListBox1.List(dfr, 4) = X.Cells(i, 5)
ListBox1.List(dfr, 5) = X.Cells(i, 6)
ListBox1.List(dfr, 6) = X.Cells(i, 7)
ListBox1.List(dfr, 7) = X.Cells(i, 8)
ListBox1.List(dfr, 8) = X.Cells(i, 9)
ListBox1.List(dfr, 9) = X.Cells(i, 10)
ListBox1.List(dfr, 10) = X.Cells(i, 11) '.Value
ListBox1.List(dfr, 11) = X.Cells(i, 12) '.Value
dfr = dfr + 1
End If
Next i
Next X
Call Main
Call Sort
شكرا جزيلا ا/ محمد هشام لقد تم الحل ونسيت ان ارفقه