مطلوب مساعدة فى اكتشاف خطأ في كود VBA

[زكي 1979]

هذا الكود للبحث وأستخلاص نتائج من مجموعة شيتات لكن المشكل أنه يستخرج نتائج شيت واحدة فقط. كما أنه لا يسمح بتكرار الأستعلام اكثر من مرة. اين الخطأ أيها المبدعون؟

Sub Searching()
i = 8
For sh = 2 To Sheets.Count
For Each C In Sheets(sh).Range("F8:F" & Sheets(sh).Cells(Rows.Count, "F").End(xlUp).Row)
If C = Sheets(1).[B3] Then
Sheets(1).Cells(i, 1) = Sheets(sh).Name
Sheets(1).Cells(i, 2) = Sheets(1).[B3]
For j = 3 To 9
Sheets(1).Cells(i, j) = Sheets(sh).Cells(C.Row, j + 4).Value
Next
i = i + 1
End If
Next
Next
End Sub

programe.xlsm

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استخدم هذا الكود

Sub suivie2()
Dim Sh As Worksheet, ws As Worksheet, C As Range
Dim i As Long, p As Long
Dim x, y, z
Set Sh = Sheets("suivie")
x = Year(Sh.Range("B3"))
y = Month(Sh.Range("B3"))
z = Day(Sh.Range("B3"))
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "suivie" Then
For Each C In ws.Range("F8:F" & ws.Range("F" & Rows.Count).End(xlUp).Row)
If Year(C.Value) = x Then
If Month(C.Value) = y Then
If Day(C.Value) = z Then
p = p + 1
Sh.Cells(p + 7, 1) = ws.Range("D5")
For i = 0 To 7
Sh.Cells(p + 7, i + 2) = C.Offset(0, i)
Next
End If
End If
End If

Next
End If
Next

End Sub

 

[زكي 1979]

شكرا. جاري المحاولة

[زكي 1979]

اخي زيزو شكرا جزيلا على الكود. يعمل بشكل جميل لكن هناك مشكلة فيه. انه عند اعادة البحث يبقى البحث السابق موجود مع انه غير متطابق مع تاريخ البحث.  

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استبدل الكود السابق بهذا الكود

Sub suivie()
Dim Sh As Worksheet, ws As Worksheet, C As Range
Dim i As Long, p As Long
Dim x, y, z
Set Sh = Sheets("suivie")
Sh.Range("A8:I" & Sh.Range("B" & Rows.Count).End(xlUp).Row).ClearContents
x = Year(Sh.Range("B3"))
y = Month(Sh.Range("B3"))
z = Day(Sh.Range("B3"))
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "suivie" Then
For Each C In ws.Range("F8:F" & ws.Range("F" & Rows.Count).End(xlUp).Row)
If Year(C.Value) = x Then
If Month(C.Value) = y Then
If Day(C.Value) = z Then
p = p + 1
Sh.Cells(p + 7, 1) = ws.Range("D5")
For i = 0 To 7
Sh.Cells(p + 7, i + 2) = C.Offset(0, i)
Next
End If
End If
End If

Next
End If
Next

 

[زكي 1979]

شكرا جزيلا استاذي الكريم وبارك الله لك في اهلك جميعا. الف شكر