كود ترحيل

[AMER LIBYAN]

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

ورقة عمل Microsoft Excel جديد ‫‬.rar

تم تعديل يوليو 30, 2018 بواسطه AMER LIBYAN
اضافة مرفق

[AMER LIBYAN]

نحن ننتظر المساعده

 

 

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

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

استخدم هذا الكود

الضغط على زر الترحيل مرة واحدة حتى لا تتكرر عملية الترحيل

Sub TrasfData()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long
Set ws = Sheets("البيانات")
Set Sh = Sheets("امر صرف")
LR = ws.Range("B" & Rows.Count).End(xlUp).Row
If LR < 2 Then
LR = 2
Else
LR = LR
ws.Range("B" & LR + 1).Value = Sh.Range("G5").Value
ws.Range("C" & LR + 1).Value = Sh.Range("D5").Value
ws.Range("D" & LR + 1).Value = Sh.Range("I2").Value
ws.Range("A" & LR + 1).Value = LR - 1
End If
End Sub

 

[AMER LIBYAN]

شكرااستاد زيزو ..وبارك الله فيك ولو تكرمت ان يكون هناك رساله  تم الترحيل

 

 

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

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

ضع هذا العبارة بآخر شطر بالكود

msgbox "تم الترحيل بنجاح"

 

 

[AMER LIBYAN]

يرجى التعديل علما انني مبتدي...

ورقة عمل Microsoft Excel جديد ‫‬.rar

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

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

اليك الملف جاهز تفضل

 

 

 

ورقة عمل Microsoft Excel جديد ‫‬.rar

[AMER LIBYAN]

رحم الله والديك شكرا