نقل مبالغ من عمود الى عمود اخر عن تلوين الخلية

[ميدو63]

دفعات سداد.xlsxالسادة الأفاضل

هل اطمع في المساعدة بكود

عمل على نقل مبالغ من عمود إلى عمود أخر

عند تلوين الخلية وتفريغ الخلية الأصلية (الملونة)

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

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

استخدم الكود الاتى

Sub SetlColr()
Dim ws As Worksheet
Dim LR As Long, C As Range
Set ws = Sheets("Sheet1")
LR = ws.Range("A" & Rows.Count).End(3).Row
For Each C In ws.Range("B3:B" & LR)
If C.Value > 0 Then
x = C.Interior.ColorIndex
If x = 6 Then
C.Offset(0, 1) = C.Value
C.ClearContents
Else
Exit Sub
End If
End If
Next
End Sub

 

[ميدو63]

أشكرك وجارى تجربتة بارك الله فيك

[ميدو63]

أستاذنا الفاضل

الكود يعمل ولكن بالترتيب بمعنى لابد من تلوين المبالغ في الخلايا بالترتيب ليتم النقل

ولكن في الحقيقة لا يتم السداد بالترتيب

(بمعنى إن اليوم العميل رقم 5 تم تلوين خلية السداد فيتم نقله للعمود الأخر - ثم في يوم آخر تم السداد من العميل رقم 20 فيتم تلوينه ثم يتم نقله...وهكذا)

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

وهل ممكن أن يتم النقل فور تلوين الخليه

 

أشكرك

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

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

قم بالغاء هذه العبارة من الكود

Exit Sub

و ينتهى الامر

[ميدو63]

أشكرك بارك الله فيك

[كله على الله]

ممكن نسخه من الشيت فيه الكود

[ميدو63]

سوف ارفع الشيت  ولكنه ليس على الموبيل الان

 

[ميدو63]

 

الشيت بعد إضافة الكود  وإضافة سطر لحذف الألوان عند الترحيل والانتقال لأي خلية أخرى

دفعات سداد.xlsm

 

الشيت بعد إضافة الكود  وإضافة سطر لحذف الألوان عند الترحيل والانتقال لأي خلية أخرى