تعديل كود

[mselmy]

السلام عليكم 

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

Sub kashfsanok()

Run "offFilter"

 

Dim mo As String

Dim ws As Worksheet

 

Dim Lr As Long, i As Long

Dim r As Integer

mo = Range("b3").Value

 

Range("a5:f1000").ClearContents

 

Application.ScreenUpdating = False

 

With ActiveSheet

    Lr = Sheets("بيان_قبض").Cells(.Rows.Count, "b").End(xlUp).Row

   For i = 2 To Lr

     

      If Sheets("بيان_قبض").Cells(i, "b") <> "" And Sheets("بيان_قبض").Cells(i, "c") >= [c3] And Sheets("بيان_قبض").Cells(i, "c") <= [d3] Then

        r = r + 1

 Cells(r + 4, "a").Value = Sheets("بيان_قبض").Cells(i, "c").Value

 Cells(r + 4, "b").Value = Sheets("بيان_قبض").Cells(i, "e").Value

 Cells(r + 4, "c").Value = Sheets("بيان_قبض").Cells(i, "f").Value

 Cells(r + 4, "d").Value = Sheets("بيان_قبض").Cells(i, "b").Value

 Cells(r + 4, "e").Value = Sheets("بيان_قبض").Cells(i, "g").Value & " " & Sheets("بيان_قبض").Cells(i, "h").Value

 Cells(r + 4, "f").Value = Sheets("بيان_قبض").Cells(i, "d").Value

End If

 

Next

End With

 

 

Run "OnFiltercashf"

 

End Sub

[ياسر أحمد الشيخ]

ارفق ملف أخى

[mselmy]

ها هو الملف ارجو ان تكون فكرته واضحه

استخراج كشف حساب.rar

[ياسر أحمد الشيخ]

استبدل أخى كود كشف_حساب بالكود التالى:

وذلك ابتداء من dim mo as string

Dim mo As String

Dim Lr As Long, i As Long
Dim r As Integer
mo = Range("b3").Value
sh = [b2]
Range("a5:e1000").ClearContents

Application.ScreenUpdating = False
With ActiveSheet
    Lr = Sheets(sh).Cells(.Rows.Count, "b").End(xlUp).Row
   For i = 3 To Lr
       If mo = CStr(Sheets(sh).Cells(i, "b")) And Sheets(sh).Cells(i, "f") >= [d3] And Sheets(sh).Cells(i, "f") <= [e3] Then
        r = r + 1
 Cells(r + 4, "a").Value = Sheets(sh).Cells(i, "f").Value
 Cells(r + 4, "b").Value = Sheets(sh).Cells(i, "d").Value
 Cells(r + 4, "c").Value = Sheets(sh).Cells(i, "c").Value
 Cells(r + 4, "d").Value = Sheets(sh).Cells(i, "g").Value
 Cells(r + 4, "e").Value = Sheets(sh).Cells(i, "h").Value
End If

Next
End With

Run "btnSort_Click"
Run "OnFiltercashf"

End Sub

أرجو أن يكون هذا طلبك

[ياسر أحمد الشيخ]

اذا كان الجواب صحيح أخى اختر "تحديد كأفضل إجابة"