مساعدة بكودين احدهم ترحيل والاخر جلب بيانات بالتاريخ

[abouelhassan]

بسم الله والصلاة والسلام على رسول الله عليه الصلاة والسلام

احبابى الكرام احتاج مساعدتكم

الكود الاول-كود ترحيل صفحة tarhel ترحيل التاريخ ورقم الصرف مع كل بيان اختيار الشيت الذى سيتم الترحيل اليه من القائمة واختيار اسم العمود المراد الترحيل من قائمة 

الكود الثانى- كود جلب البيانات لصفحة TAKRIR عن طريق اختيار التاريخ من والتاريخ الى فيتم استدعاء البيانات الموضحة بالشيت 

شكر وتقدير وخالص الدعاء من اخيكم

ترحيل مدين ودائن.xlsb

[حسين مامون]

السلام عليكم

ملاحظة تم تعديل الجدول في الصفحات

هذا الكود للترحيل 

معمول بالحلقات التكرارية ولكن فعاليته جيدة واتمنى ان يفي بالغرض

Sub envoier()
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng1, rng2 As Range
Dim lr1, lr2 As Long
Dim x, x2, S As Long

Set ws = Sheets("Tarheel")
Set rng1 = ws.[e1]: Set rng2 = ws.[f1]
Application.ScreenUpdating = False
lr1 = ws.Cells(Rows.Count, 4).End(3).Row
If lr1 = 2 Then Exit Sub
For S = 3 To lr1
For Each sh In Sheets
If sh.Name <> "Tarheel" And sh.Name <> "TAKRIR" Then
If ws.Cells(S, 4) = sh.Name Then
 For x = 4 To 15
  If sh.Cells(1, x) = rng1 Then
           lr2 = sh.Cells(Rows.Count, 1).End(3).Row + 1
'          sh.Activate
           sh.Range("a" & lr2).Resize(, 2).Value = ws.Range("a2").Resize(, 2).Value
           sh.Range("c" & lr2).Value = ws.Cells(S, "c").Value
           sh.Range("a" & lr2).Offset(, x - 1).Resize(, 2).Value = _
           ws.Cells(S, "e").Resize(, 2).Value
  End If
Next x
End If
End If
Next sh

Next S
If MsgBox("هل تريد افراغ البيانات في الشيت", vbExclamation + vbYesNo) = vbYes Then
ws.Range("c3:f" & lr1).Select
End If
Application.ScreenUpdating = True
End Sub

ترحيل مدين ودائن.xlsb

[حسين مامون]

وهنا تم اضافة كود استعلام بين تاريخين

Sub Renseignements()
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng1, rng2 As Date
Dim lr1, lr2 As Long
Dim x As Long

Set ws = Sheets("TAKRIR")
 rng1 = ws.[c2]:  rng2 = ws.[d2]
Application.ScreenUpdating = False
lr1 = ws.Cells(Rows.Count, 1).End(3).Row + 1
ws.Range("a5:m" & lr1).ClearContents
For Each sh In Sheets
If sh.Name <> "Tarheel" And sh.Name <> "TAKRIR" Then

lr2 = sh.Cells(Rows.Count, 1).End(3).Row
  For x = 3 To lr2
    lr1 = ws.Range("a" & Rows.Count).End(xlUp).Row + 1
     Select Case sh.Cells(x, 1).Value2: Case rng1 To rng2
      ws.Range("a" & lr1).Value = sh.Name
      ws.Range("a" & lr1).Offset(, 1).Resize(1, 14).Value = sh.Cells(x, "b").Resize(1, 14).Value
     End Select
  Next x
  End If
Next sh
Application.ScreenUpdating = True

End Sub

 

ترحيل مدين ودائن.xlsb

[abouelhassan]

والله العظيم ربنا يحفظك ويبارك لك ويرزققك من حيث لاتحتسب يارب انا اشكرك من كل قلبى

حفظك الله لكل عائلتك اللهم امين

رائع تسلم يديك وعينيك يارب

احتاج بكود التقرير اخى ان يقوم بالاستدعاء باتجميع

الان يقوم باستدعاء الصفوف لنفس الشيت تحت بعض اريد ان يستدعى اسم الشيت مرة واحدة ويجمع كل الدائن وكل المدين لنفس التاريخ اخى الكريم

ارفقت ملف به شرح مع خالص الدعاء لحضرتك

شكر وتقدير واحترام لك اخى الفاضل الاستاذ حسين مامون

ترحيل مدين ودائن.xlsb

[حسين مامون]

ترحيل مدين ودائن (1).xlsb

[abouelhassan]

ربنا يرضى عنك استاذ حسين مامون بارك الله لك فى كل حياتك

لم يتم استاذى التجميع بمعنى الشيت tim يوم 1/1 دائن 1000 ويوم 2/1 دائن 2000 اريد عند الاستدعاء ان يأتى الشيت tim  دائن 3000

اما الان لازال يأتى اسم الشيت tim 1000 وتحته tim 2000 فاهمنى استاذى اريد اسم الشيت يكون مرة واحدة ودائن او مدين فى هذا التاريخ متجمع

وبكده يكون جميلك على راسى والف شكر وحفظك ورعاك رب العالمين

شكر وتقدير واحترام

[حسين مامون]

سكرا لك اخي ولك نصيب من الاجر ان شاء الله

بالنسبة لسؤالك اولا لم تشر الى ذلك في مشاركتك الاولى بحيث اختصر طلبك (هكذا:كود الثانى- كود جلب البيانات لصفحة TAKRIR عن طريق اختيار التاريخ من والتاريخ الى فيتم استدعاء البيانات الموضحة بالشيت )

عموما ساحاول لما تسمح ظروفي رغم صعوبة الطلب

وهذا ان لم يتفضل احد الاساتدة بالمساعدة

تحياتي

[حسين مامون]

ربما يكون ما نقصد

ترحيل مدين ودائن (1).xlsb

[abouelhassan]

تسلم ايدك استاذ حسين مامون ربنا يكرمك يارب وجزيت الجنة بأذن الله

حفظك الله ورعاك ونجاك 

كل الشكر والتقدير وفائق الاحترام من اخيك

[حسين مامون]

الحمد لله وبنعمته تتم الصالحات

اكرمك الله ورعاك اخي الكريم