بحث بين تاريخين

[tlayt kamal]

المطلوب فضلا وليس امرا

ماكرو

عند ادخال رقم العميل في H2

و التاريخ من في I2

والتاريخ الى في J2

ترحل البيانات من شيت1 الى شيت2 

حفظكم الله

 

DT.xlsm

[سليم حاصبيا]

جرب هذا الكود

Option Explicit
Private Sub Worksheet_Activate()
fil_dat_val
End Sub
'+++++++++++++++++++++++++++++++++++
Sub fil_dat_val()
Application.ScreenUpdating = False
Dim I%: I = 6
Dim arr
Dim rg As Object
Set rg = CreateObject("system.collections.arraylist")
With rg
 Do Until Sheets("sheet1").Range("B" & I) = vbNullString
  If Not .contains(Sheets("sheet1").Range("A" & I).Value) Then _
  .Add Sheets("sheet1").Range("A" & I).Value
 I = I + 1
 Loop
 .Sort
 arr = .toarray
 arr = Join(arr, ",")
 End With
 
 With Sheets("sheet2").Range("H2").Validation
 .Delete
 .Add xlValidateList, Formula1:=arr
  End With
End Sub
'==============================
Sub get_values()
Dim rg As Object, I%, m%, kY
Dim Sh1 As Worksheet, Sh2 As Worksheet
I = 6
Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2")
Set rg = CreateObject("Scripting.dictionary")
Sh2.Range("a6").CurrentRegion.Offset(1).Clear
With Sh1
 Do Until Not IsNumeric(.Range("a" & I))
      If .Range("A" & I) = Sh2.Range("h2") _
       And .Range("C" & I) >= Sh2.Range("I2") _
       And .Range("C" & I) <= Sh2.Range("J2") Then
       rg(m) = _
        .Range("C" & I).Value & "*" & _
        .Range("D" & I).Value & "*" & _
        .Range("E" & I).Value
        m = m + 1
      End If
       I = I + 1
  Loop
  End With
  If rg.Count = 0 Then GoTo End_Me
  m = 6
  For Each kY In rg.keys
      Sh2.Cells(m, 1).Resize(, 3) = _
      Split(rg(kY), "*"): m = m + 1
  Next
    With Sh2.Range("A6:C" & m - 1)
        .Value = .Value
        .InsertIndent 1
        .Borders.LineStyle = 1
        .Font.Size = 14
    End With
End_Me:
  Application.ScreenUpdating = True
 Set rg = Nothing
End Sub

 

Saerch_by_date.xlsm

[tlayt kamal]

حفظك الله استاذ سليم 

هذا ما اريد بالظبط 

روعة