ترحيل العملاء المسددين

[محمود رواس]

الاخوة المحترمين

الشيت المرفق يوجد به عملاء لاتزال مديونياتهم قائمه ويوجد عملاء انتهت مديونياتهم ، المطلوب ترحيل العملاء الذين انتهت مديونياتهم من شيت البيانات الى شيت بيانات العملاء المسددين مع الحفاظ على الرقم التسلسلي في شيت البيانات بدون اي تغيير ، طبعا يتم الترحيل عندما يكون المتبقي على العميل صفر فقط ، وايضا يوجد خانه بها كود للعميل كيف ممكن يظهر هذا الكود بشكل اوتماتيكي حيث ان اول عميل كوده iT00001 وهو كود متسلسل بمعنى ان العميل الثاني سوف يكون كوده iT00002 وهكذا .

وشكراً ،،،،

New i-Tech softwear - V1 0.rar

[الـعيدروس]

السلام عليكم

جرب هذا الكود

واعتقد انه يلزم حذف الصفوف الرحله ؟

Public Sub Tr_A()

Dim Sn As Worksheet, Sh As Worksheet

Dim L_r&, rw&

Dim Rn As Range, R As Range

Set Sn = Sheets("البيانات")

Set Sh = Sheets("البيانات العملاء المسددين")

With Application

   .ScreenUpdating = False

   .EnableEvents = False

L_r = Sn.Cells(Rows.Count, 3).End(xlUp).Row

Set Rn = Sn.Range(Sn.Cells(15, 45).Address, Sn.Cells(L_r, 45).Address)

For Each R In Rn

If R.Value = 0 Then

With Sh

rw = .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row

Sn.Range(Sn.Cells(R.Row, 4), Sn.Cells(R.Row, 45)).Copy .Cells(rw, 2)

Application.CutCopyMode = False

End With

End If

Next

  .EnableEvents = True

  .ScreenUpdating = True

End With

Set R = Nothing: Set Rn = Nothing

End Sub

[محمود رواس]

استاذنا الفاضل ابو ناصر

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

وشكراً ،،،،

[الـعيدروس]

جرب هذ التعديل

أتمنا أن اكون فهمت طلبك

Public Sub Tr_A()

Dim Sn As Worksheet, Sh As Worksheet

Dim L_r&, rw&

Dim Rn As Range, R&

Set Sn = Sheets("البيانات")

Set Sh = Sheets("البيانات العملاء المسددين")

With Application

   .ScreenUpdating = False

   .EnableEvents = False

L_r = Sn.Cells(Rows.Count, 3).End(xlUp).Row

For R = L_r To 15 Step -1

If Sn.Cells(R, 45).Value = 0 Then

With Sh

rw = .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row

With Sn.Range(Sn.Cells(R, 4), Sn.Cells(R, 45))

.Copy

Sh.Cells(rw, 2).PasteSpecial xlPasteValues

With Sn

Union(.Cells(R, 7), .Cells(R, 8), .Cells(R, 9), .Cells(R, 10), .Cells(R, 11), .Cells(R, 12), _

.Cells(R, 13), .Cells(R, 17), .Cells(R, 19), .Cells(R, 20), .Cells(R, 21), .Cells(R, 23), _

.Cells(R, 25), .Cells(R, 27), .Cells(R, 29), .Cells(R, 31), .Cells(R, 33), .Cells(R, 35), _

.Cells(R, 37), .Cells(R, 39), .Cells(R, 41), .Cells(R, 43)).ClearContents

End With

End With

Application.CutCopyMode = False

End With

End If

Next

With Sn.Rows("15:" & Sn.Cells(Rows.Count, 4).End(xlUp).Row)

.Sort Key1:=Sn.Cells(15, 5), Order1:=xlDescending, Header:=xlNo

End With

  .EnableEvents = True

  .ScreenUpdating = True

End With

End Sub

[جمال عبد السميع]

بعد إذن إخوتي هذه طريقة بالمعادلات

ترحيل عملاء.rar

[محمود رواس]

والله لساني يعجز عن شكركم استاذنا ابو ناصر واستاذنا محمود زادكم الله من علمه وفضله ونفع بكم ، لكن لي سؤال هل من الممكن عند الترحيل يتم الغائها من الشيت الرئيسي .

وشكراً ،،،،

[احمدزمان]

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

بعد اذن اخونا الرائع ابو نصار

اخي محمود تم تطبيق كود اخونا ابو نصار على الملف المرفق وهو يعمل حسب ما فهمت من سؤالك

New i-Tech softwear - V1 0.rar