أبوســـارة1973 قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 (معدل) السلام عليكم رمضان كريم هل ممكن أن أحصل على كود يقوم بنسخ قيمة خلية ما في خلايا عمود بحسب العدد المدون في الخلية المقابلة لها؟ الشرح في الملف المرفق نسخ خلايا.rar تم تعديل يونيو 7, 2017 بواسطه أبوســـارة1973 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 ربما يكون المطلوب نسخ خلايا Salim.rar رابط هذا التعليق شارك More sharing options...
أبوســـارة1973 قام بنشر يونيو 7, 2017 الكاتب مشاركة قام بنشر يونيو 7, 2017 شكرا أستاذ سليم ولكن المطلوب كود vba رابط هذا التعليق شارك More sharing options...
خالد الرشيدى قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 (معدل) السلام عليكم بعد اذن استاذي / سليم حاصبيا اخى الكريم جرب الكود التالى كأحد طرق الحل Sub Khaled() Dim cll As Range ,Dim Lr As Long Range("C3:C1000").ClearContents For Each cll In Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) Lr = Cells(Rows.Count, "C").End(xlUp).Row cll.Copy Destination:=Range("C" & Lr + 1 & ":C" & Lr + cll.Offset(, 1).Value) Next End Sub تم تعديل يونيو 7, 2017 بواسطه خالد الرشيدى رابط هذا التعليق شارك More sharing options...
أبوســـارة1973 قام بنشر يونيو 7, 2017 الكاتب مشاركة قام بنشر يونيو 7, 2017 شكراً أستاذ خالد الرشيدي : يبدو أن الكود لا يعمل فلقد جربته على الملف ولكن لا يعطي نتيجة رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر يونيو 7, 2017 أفضل إجابة مشاركة قام بنشر يونيو 7, 2017 أخي الكريم أبو سارة .. جربت كود الأخ الحبيب خالد ويعمل بشكل جيد جداً عموماً إثراءً للموضوع هذا كود آخر مقارب لكود الأخ خالد لعله يفيدك Sub PopulateNumbers() Dim cell As Range Dim x As Long Dim lr As Long Range("C3:C1000").ClearContents For Each cell In Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row) x = cell.Offset(, 1) lr = Cells(Rows.Count, 3).End(xlUp).Row + 1 Range("C" & lr).Resize(x, 1).Value = cell.Value Next cell End Sub 2 رابط هذا التعليق شارك More sharing options...
أبوســـارة1973 قام بنشر يونيو 7, 2017 الكاتب مشاركة قام بنشر يونيو 7, 2017 ألف شكر لك حبيبي ياسر خليل أبو البراء هذا يعمل عندي بفاعلية قصوى وهو المطلوب في ميزان حسناتك وبارك الله لك والشكر موصول لكل من ساعدني في هذا العمل جزاكم الله خير الجزاء 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 زيادة في اثراء الموضوع هذا الكود Option Explicit Sub copy_as_you_want() Dim i, c As Integer Dim Cont Dim Lr As Long Lr = ActiveSheet.Cells(Rows.count, 3).End(3).Row Range("c3:c" & Lr).ClearContents i = 3 c = 3 Do While Cells(i, 1) <> "" Cont = Cells(i, 1).Offset(0, 1).Value If Not IsNumeric(Cont) Or Cont = "" Or Cont = 0 Then i = i + 1: GoTo 1 Cont = Int(Abs(Cont)) Range("c" & c & ":c" & c + Cont - 1).Value = Cells(i, 1).Value i = i + 1 c = c + Cont 1: Loop End Sub 1 1 رابط هذا التعليق شارك More sharing options...
علي بطيخ سالم قام بنشر نوفمبر 19, 2018 مشاركة قام بنشر نوفمبر 19, 2018 في ٧/٦/٢٠١٧ at 16:29, سليم حاصبيا said: زيادة في اثراء الموضوع هذا الكود Option Explicit Sub copy_as_you_want() Dim i, c As Integer Dim Cont Dim Lr As Long Lr = ActiveSheet.Cells(Rows.count, 3).End(3).Row Range("c3:c" & Lr).ClearContents i = 3 c = 3 Do While Cells(i, 1) <> "" Cont = Cells(i, 1).Offset(0, 1).Value If Not IsNumeric(Cont) Or Cont = "" Or Cont = 0 Then i = i + 1: GoTo 1 Cont = Int(Abs(Cont)) Range("c" & c & ":c" & c + Cont - 1).Value = Cells(i, 1).Value i = i + 1 c = c + Cont 1: Loop End Sub ممكن أستاذ سليم تنفذه على الملف الخاص بي بارك الله فيك ارجوا التعديل.xlsx رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 19, 2018 مشاركة قام بنشر نوفمبر 19, 2018 جرب هذا الشيء الكود Option Explicit Sub give_data() Dim My_sh As Worksheet Set My_sh = Sheets("salim") If ActiveSheet.Name <> My_sh.Name Then Exit Sub Dim i As Byte Dim Fasl$ Dim m%: m = 2 With My_sh Dim rg As Range: Set rg = .Range("d3:d6") .Range("B2:b" & Rows.Count).ClearContents For i = 1 To 4 Fasl = rg.Cells(i).Offset(, 1) & " " .Range("b" & m).Resize(rg.Cells(i)) = Fasl m = m + rg.Cells(i) Next End With End Sub الملف tekrar_Salim.xlsm 2 رابط هذا التعليق شارك More sharing options...
علي بطيخ سالم قام بنشر نوفمبر 19, 2018 مشاركة قام بنشر نوفمبر 19, 2018 (معدل) ممتاااااااااااااااااااااااااااااز لكن كيف أطبقه على ملف آخر يعني لو نقلت الكود لملف آخر مع تغيير الأعمدة والصفوف ما هو المفترض أقم بتغييره في هذا الكود والمعذرة لأني ضعيف في الفيجوال بارك الله فيك استاذ سليم ودائماً أنت المتصدر وفقك الله تم تعديل نوفمبر 19, 2018 بواسطه علي بطيخ سالم رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 19, 2018 مشاركة قام بنشر نوفمبر 19, 2018 ما عليك الا ان تدرس الكود خطوة خطوة و يتضح لك جيداً ماذا يعني كل سطر و كل متغير فيه وعلى هذا الاساس يمكنك التعديل 1 رابط هذا التعليق شارك More sharing options...
علي بطيخ سالم قام بنشر نوفمبر 19, 2018 مشاركة قام بنشر نوفمبر 19, 2018 شكراً لك استاذ سليم وبارك الله فيك وجزاك الله خيراً رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان