اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم

محتاج تصميم زر يحتوي على كود يرحل الارقام المكتوبة في خانة ( مخصصات المطار  ، او التي تم التعديل عليها في نفس الخانة) من شيت وصل  الى شيت البيانات على اساس رقم المستند

ترحيل ارقام من شيت الى شيت.xlsx

قام بنشر

بدون زر ادخل قيمة في المدى J8:J1000 وسيرحل الى الشيت الاخر باذن الله

تحياتي ...الكود في حدث الشيت

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Set ws = Sheets("البيانات")
Dim c, x
Application.ScreenUpdating = False
If Not Intersect(Target, Range("j8:j1000")) Is Nothing Then
c = Target.Offset(, -9)
x = Application.Match(c, ws.Columns(1), 0)
'Target.Copy
ws.Cells(x, 1).Offset(, 19) = Target
End If
Application.ScreenUpdating = True
End Sub

ترحيل ارقام من شيت الى شيت.xlsm

  • Like 2
  • 3 weeks later...
  • أفضل إجابة
قام بنشر

أخي الكريم صاحب الموضوع

اول خطوة لتعديل الكود فهمه وفهم متغيراته 

والكود القديم يقوم بنقل قيمة العمود J إلى العمود 19 بعد العمود الأول في شيت البيانات

والمطلوب إضافة نفس الكود عند تعديل العمود G ويتم نقله إلى العمود 16 بعد العمود الأول في شيت البيانات

لذلك يصبح الكود بعد التعديل

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Set ws = Sheets("البيانات")
Dim c, x
Application.ScreenUpdating = False
If Not Intersect(Target, Range("g8:g1000")) Is Nothing Then
c = Target.Offset(, -9)
x = Application.Match(c, ws.Columns(1), 0)
ws.Cells(x, 1).Offset(, 16) = Target
Ebd If
If Not Intersect(Target, Range("j8:j1000")) Is Nothing Then
c = Target.Offset(, -9)
x = Application.Match(c, ws.Columns(1), 0)
ws.Cells(x, 1).Offset(, 19) = Target
End If
Application.ScreenUpdating = True
End Sub

لاحظ تم تكرار سطور الشرط للعمودين g و j مع تغيير رقم العمود المرحل إليه مرة 19 ومرة 16

بالتوفيق

  • Like 2
قام بنشر

السلام عليكم

تم فهم الكود وتم التعديل وتم الأمر - نجح الحمد لله - مشكور استاذ محمد صالح

 

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information