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

[nawras_271]

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

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

وانى محتاجة بسرعة جدا

جزاكم الله كل خير

اخوكم ايمن

ِAyman.rar

[عبدالله المجرب]

السلام عليكم

اخي ضع هذا الكود في زر امر

Sub Trhl_Abu_Ahmed()

Dim i As Integer, LR As Integer

t = 1

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To 5

Cells(LR + 1, i).Value = Cells(i + 15 + t, "G").Value

t = t + 1

Next i

End Sub

[عبدالله المجرب]

واذا اردت مسح البيانات بعد الترحيل من الخانات التي في العمود G

فالكود سيكون كذا

Sub Trhl_Abu_Ahmed()

Dim i As Integer, LR As Integer

t = 1

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To 5

Cells(LR + 1, i).Value = Cells(i + 15 + t, "G").Value

Cells(i + 15 + t, "G").Value = ""

t = t + 1

Next i

End Sub

وهذا الكود برسالة تنبيهية اذا كان احدى الخانات او اكثر فارغة بعدم اكمال الترحيل

Sub Trhl_Abu_Ahmed()

Dim i As Integer, LR As Integer

If Application.WorksheetFunction.Count(Range("G17:I26")) < 5 Then

MsgBox "لم يتم الترحيل لعدم اكمال الحقول المرحلة ", vbOKOnly + vbCritical, "تنبيه": Exit Sub

End If

t = 1

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To 5

Cells(LR + 1, i).Value = Cells(i + 15 + t, "G").Value

Cells(i + 15 + t, "G").Value = ""

t = t + 1

Next i

End Sub

[nawras_271]

اخى الكريم

اشكرك على الرد ولكنى لا اعرف اين زر امر معزرة اخى الكريم لو ممكن توضحة لى او تشرح لى كيف افعلها

شكرا جداااااااا

[عبدالله المجرب]

اذاً خذ المرفق وفيه زر الامر

ِAyman.rar

[saad abed]

اخى عبدالله

بارك الله فيك

كود جميل

سعد عابد

[abouelhassan]

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

روائع اخى الاستاذ عبدالله

ماشاء الله عليك

احترامى

[الحسامي]

السلام عليكم

اخي الحبيب ابو احمد

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

لكن لي ملاحظة صغيرة جدا عليه ولا تؤثر على الكود

لماذا استخدمت ال"Counter-t" طالما لديك عداد يلبي الحاجة التي استخدمته لاجلها "i" ويمكنك استخدام العداد على هذا النحو

Dim i As Integer, LR As Integer

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To 5

Cells(LR + 1, i).Value = Cells(i * 2 + 15, "G").Value

Next i

[عبدالله المجرب]

الاستاذ الفاضل عماد الحسامي

لسى احنا بنخطي الخطوات الاولى في الاكواد ولا بد من وجود عدم الانتباه لمثل هذه الحركات الجميلة

شكراً على التشجيع والكلام الحلو

ابواحمد

[ياسر الحافظ]

الاساتذة الاعزاء :

الاستاذ " ابو احمد " عبد الله المجرب

الاستاذ " الحســــــــــــــــــــــــــامي "

جزاكم الله كل الخير

وفقكم الله

ابو الحارث