كيفيه ربط خلايا فى ورقه بخلايا مختلفه بورقه اخرى

[رضا على]

كيفيه ربط خلايا فى ورقه بخلايا مختلفه بورقه اخرى المرفق ملف بيانات نريد ربطه بورقه ارقام جلوس وياسلام لو بالاكواد

123.rar

[سليم حاصبيا]

جرب هذا الكود

Sub extract_data()
Dim x, i, lr As Integer
Dim My_sheet As Worksheet
Dim Source_sheet As Worksheet
Set Source_sheet = Sheets("البيانات")
Set My_sheet = Sheets("ارقام الجلوس")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
My_sheet.Columns(2).ClearContents
My_sheet.Columns(5).ClearContents
lr = My_sheet.Cells(Rows.Count, 1).End(3).Row
x = 1
For i = 2 To lr

My_sheet.Range("b" & x).Resize(5, 1) = Application.WorksheetFunction.Transpose(Source_sheet.Range("a" & i).Resize(1, 5))
My_sheet.Range("b" & x + 4).NumberFormat = "m/d/yyyy"
My_sheet.Range("e" & x).Resize(5, 1) = Application.WorksheetFunction.Transpose(Source_sheet.Range("a" & i + 1).Resize(1, 5))
My_sheet.Range("e" & x + 4).NumberFormat = "m/d/yyyy"
i = i + 1
x = x + 6

Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

تم تعديل ديسمبر 11, 2015 بواسطه سليم حاصبيا

[ابو ليالى]

بارك الله فيك أستاذ (سليم ) وجزاك الله كل الخير  وزادك من علمه 

بعد التجربه على الملف الكود  شغال تمام  تسلم ايديك 

وللأخ رضا  ممكن تجرب كود الاستاذ الكبير سليم 

او تجرب هذا الملف سيلبى طلبك بإذن الله تعالى

والملف منقول للأمانه وانا أعمل به منذ فتره

2015 أرقام الجلوس والمناداة.rar

[رضا على]

 

---

---