اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر (معدل)

اريد أضع اسم الصنف .. لبن مثلاوالتاريخ 

01/01/2023

31/012023

تظهر النتائج في الجدول الحركات للبن التي تاريخها فقط بين التاريخين المذكورين

 

الصفحة اسمها 

الشهر

تم تعديل بواسطه عمر طاهر
  • تمت الإجابة
قام بنشر (معدل)

تفضل جرب 

 

Sub filtre()
Dim sh As Worksheet, sh2 As Worksheet
Dim lastRow As Long, lrow As Long, Article As Range
Set sh = ThisWorkbook.Sheets("الشهر")
lrow = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
Set Rng = sh.Range("c2")
Set sh2 = ThisWorkbook.Sheets("تسجيل المخزون")
lastRow = sh2.Range("A" & Rows.Count).End(xlUp).Row

If Rng.Value = Empty Then MsgBox "المرجوا ادخال الصنف": Exit Sub
Set Article = sh2.Range("D:D").Find(What:=Rng, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Article Is Nothing Then
 Application.ScreenUpdating = False

sh.Range("A4:E" & lrow).ClearContents

sh2.Range("D1").AutoFilter Field:=4, Criteria1:="=" & Rng
sh2.Range("A1").AutoFilter Field:=1, _
      Criteria1:=">=" & sh.Range("E1").Value2, Operator:=xlAnd, _
       Criteria2:="<=" & sh.Range("E2").Value2
     
With sh2
sh2.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible).Copy
sh.Range("B4").PasteSpecial xlPasteValues
sh2.Range("B2:B" & lastRow).SpecialCells(xlCellTypeVisible).Copy
sh.Range("A4").PasteSpecial xlPasteValues
sh2.Range("D2:F" & lastRow).SpecialCells(xlCellTypeVisible).Copy
sh.Range("C4").PasteSpecial xlPasteValues


 End With
    Else
    m = MsgBox("الصنف " & " " & ST & " " & " " & "غير موجود", vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "")
     End If
    On Error Resume Next
  sh2.ShowAllData
   Application.ScreenUpdating = True

End Sub

 

 

mywork v2.xlsm

تم تعديل بواسطه Mohamed Hicham
  • Like 1

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information