يوسف عطا قام بنشر نوفمبر 10, 2011 قام بنشر نوفمبر 10, 2011 الكود التالى ( وهو لأحد عمالقة المنتدى والإيكسيل وهو أستاذنا خبور خير فلندعوا له جميعاً بأن يكون فى أتم صحة وعافية وأن يعود سريعاً للمنتدى فقد طال غيابه) يقوم بترحيل البيانات من شيت إلى عدة شيتات حسب التبويب الموجود فى أول خلية فى الصف للشيتات الأخرى التى يكون عنوان تبويبها متطابق مع هذه الخلية وقد قمت بزيادة مدى البيانات عن الكود الأصلى والنتيجة طيبة ولكن : بتكرار إستخدام الكود يتم إعادة الترحيل من جديد تحت البيانات التى سبق أن تم ترحيلها النتيجة تكون ظهور تكرارات للبيانات اسفل بعضها المطلوب تعديلان 1. أن أحدد إسم العمود أو رقمه الذى يحتوى الدليل أو البيان الذى سيستخدم للترحيل 2. أن يقوم الكود بمسح البيانات التى سبق ترحيلها قبل الترحيل الجديد شكراً مقدماً الكود كما يلى Sub Khboor_Tarheel() '============================================= ' الية الكود بعد الترحيل يقوم بمسح البيانات التي تم ترحيلها On Error Resume Next Application.ScreenUpdating = False For a = 11 To [a3000].End(xlUp).Row If Cells(a, 1) <> "" Then MySheets = Cells(a, 1) With Sheets(MySheets).[a3000].End(xlUp) .Offset(1, 0) = Cells(a, 1) .Offset(1, 1) = Cells(a, 2) .Offset(1, 2) = Cells(a, 3) .Offset(1, 3) = Cells(a, 4) .Offset(1, 4) = Cells(a, 5) .Offset(1, 5) = Cells(a, 6) .Offset(1, 6) = Cells(a, 7) .Offset(1, 7) = Cells(a, 8) .Offset(1, 8) = Cells(a, 9) .Offset(1, 9) = Cells(a, 10) .Offset(1, 10) = Cells(a, 11) .Offset(1, 11) = Cells(a, 12) .Offset(1, 12) = Cells(a, 13) .Offset(1, 13) = Cells(a, 14) .Offset(1, 14) = Cells(a, 15) .Offset(1, 15) = Cells(a, 16) .Offset(1, 16) = Cells(a, 17) .Offset(1, 17) = Cells(a, 18) .Offset(1, 18) = Cells(a, 19) .Offset(1, 19) = Cells(a, 20) .Offset(1, 20) = Cells(a, 21) .Offset(1, 21) = Cells(a, 22) .Offset(1, 22) = Cells(a, 23) .Offset(1, 23) = Cells(a, 24) .Offset(1, 24) = Cells(a, 25) .Offset(1, 25) = Cells(a, 26) .Offset(1, 26) = Cells(a, 27) .Offset(1, 27) = Cells(a, 28) .Offset(1, 28) = Cells(a, 29) .Offset(1, 29) = Cells(a, 30) .Offset(1, 30) = Cells(a, 31) .Offset(1, 31) = Cells(a, 32) .Offset(1, 32) = Cells(a, 33) .Offset(1, 33) = Cells(a, 34) .Offset(1, 34) = Cells(a, 35) .Offset(1, 35) = Cells(a, 36) .Offset(1, 36) = Cells(a, 37) .Offset(1, 37) = Cells(a, 38) .Offset(1, 38) = Cells(a, 39) .Offset(1, 39) = Cells(a, 40) End With End If ' If Sheets("ورقة1").Cells(a, "a") > "" Then Cells(a, 3).Resize(1, 4).Value = "" ' اذا اردت مسح البيانات بعد الترحيل حفز هذا السطر Next a Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" Range("a1").Select On Error Resume Next On Error GoTo 0 End Sub
يوسف عطا قام بنشر نوفمبر 10, 2011 الكاتب قام بنشر نوفمبر 10, 2011 إضافة أخرى لو تكرمتم يا أفاضل أريد أن يقوم الكود بعد الترحيل أن يخبرنى تم ترحيل عدد كذا لشيت كذا وعدد كذا لشيت كذا وعدد كذا لشيت كذا حسب البيانات التى تم ترحيلها أى بإختصار يقوم الكود بإخراج ويندو إحصاء للبيانات التى تم ترحيلها أتعشم وصلت الفكرة دمتم بود
عبدالله المجرب قام بنشر نوفمبر 11, 2011 قام بنشر نوفمبر 11, 2011 اخي يوسف جمعة مباركة ضع الكود في ملف ليسهل تتبعه وارجو منك تجربة الكود بعد ان تم اختصاره هل يؤدي نفس الغرض Sub Khboor_Tarheel() '============================================= ' ÇáíÉ ÇáßæÏ ÈÚÏ ÇáÊÑííá íÞæã ÈãÓí ÇáÈíÇäÇÊ ÇáÊí Êã ÊÑííáåÇ On Error Resume Next Application.ScreenUpdating = False For a = 11 To [a3000].End(xlUp).Row For i = 0 To 39 If Cells(a, 1) <> "" Then MySheets = Cells(a, 1) With Sheets(MySheets).[a3000].End(xlUp) .Offset(1, i) = Cells(a, i + 1) End With End If ' If Sheets("æÑÞÉ1").Cells(a, "a") > "" Then Cells(a, 3).Resize(1, 4).Value = "" ' ÇÐÇ ÇÑÏÊ ãÓí ÇáÈíÇäÇÊ ÈÚÏ ÇáÊÑííá íÝÒ åÐÇ ÇáÓØÑ Next i Next a Application.ScreenUpdating = True MsgBox "!Êã ÇáÊÑííá ÈäÌÇí", vbInformation + vbMsgBoxRight, "Êã ÇáÊÑííá" Range("a1").Select On Error Resume Next On Error GoTo 0 End Sub
يوسف عطا قام بنشر نوفمبر 11, 2011 الكاتب قام بنشر نوفمبر 11, 2011 الف شكر عبدالله بك المجرب سأجرب الكود بعد إختصاره وسأحاول رفع ملف مختصر لأن الملف الأصلى حجمه 40 ميجا بعد الضغط وهذا ما جعلنى لا أرفق ملف منذ البداية الف شكر وأتمنى التواصل فى الموضوع بإستمرار
يوسف عطا قام بنشر نوفمبر 11, 2011 الكاتب قام بنشر نوفمبر 11, 2011 أخى الغالى عبدالله المجرب دام فضلك للأسف الكود بعد إختصاره لا يعمل إليك الملف المختصر 3 شيتات فقط ( الملف الأصلى 20 شيت ملئ بالمعادلات والأكواد والتنسيقات مما يجعل رفعه بالمنتدى أمر صعب ) تم وضع الكود الأصلى والكود المختصر الذى تفضلت حضرتك بتعديله كذلك كود لمسح البيانات التى تم ترحيلها لإعادة الترحيل مرة أخرى دون تكرارها الرجاء الإفادة أفادكم الله سأركز طلباتى مرة أخرى للتذكرة 1. أن يقوم الكود بمسح البيانات التى سبق ترحيلها قبل الترحيل الجديد 2. إخراج ويندو إحصاء للبيانات التى تم ترحيلها بعد إتمام الترحيل بنجاح أو بالبيانات التى لم ترحل 3. أن أحدد إسم العمود أو رقمه الذى يحتوى الدليل أو البيان الذى سيستخدم للترحيل ترحيل معدل.rar
طارق محمود قام بنشر نوفمبر 16, 2011 قام بنشر نوفمبر 16, 2011 السلام عليكم أخي الحبيب تفضل المرفق وبه كود معدل2 وإليك الملاحظات التالية (1) قللت لك كثيرا في البيانات لتقليل وقت التنفيذ وتصغير حجم الملف ، يمكنك تزويدها كما تشاء (2) هذه الأسطر الأربعة في أول الكود ستمسح المجال A11:U3000 في جميع شيتات الملف فيما عدا شيت النتيجة كاملة For sh = 1 To Sheets.Count If Sheets(sh).Name = "النتيجة كاملة" Then GoTo 10 Sheets(sh).Range("A11:U3000").ClearContents 10 Next sh (3) وهذا إختصار لكود الأستاذ الجليل خبور خير وقد جربته ويعمل بنجاح For a = 11 To [a3000].End(xlUp).Row If Cells(a, 1) <> "" Then MySheets = Cells(a, 1) Range(Cells(a, 1), Cells(a, 40)).Copy Sheets(MySheets).[a3000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End If Next a Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" (4) وهذه الأسطر القادمة تخبرك بعدد ماتم نقله x1 = Sheets("ناجحة ومنقولة").[a3000].End(xlUp).Row - 10 x2 = Sheets("لها دور ثان").[a3000].End(xlUp).Row - 10 MsgBox ("تم ترحيل عدد " & x1 & " طالبة لناجحة ومنقولة" & Chr(10) & "وترحيل عدد " & x2 & "طالبة لها دور ثان ") (5) طلبك الأخير لم أفهمه تحديد إسم العمود أو رقمه الذى يحتوى الدليل أو البيان الذى سيستخدم للترحيل تفضل المرفق ترحيل معدل_طارق.rar
abouelhassan قام بنشر نوفمبر 16, 2011 قام بنشر نوفمبر 16, 2011 روا ئع اخوانى احترام شديد من القلب. اخيكم
يوسف عطا قام بنشر نوفمبر 16, 2011 الكاتب قام بنشر نوفمبر 16, 2011 السلام عليكم أخي الحبيب تفضل المرفق وبه كود معدل2 وإليك الملاحظات التالية (1) قللت لك كثيرا في البيانات لتقليل وقت التنفيذ وتصغير حجم الملف ، يمكنك تزويدها كما تشاء (2) هذه الأسطر الأربعة في أول الكود ستمسح المجال A11:U3000 في جميع شيتات الملف فيما عدا شيت النتيجة كاملة For sh = 1 To Sheets.Count If Sheets(sh).Name = "النتيجة كاملة" Then GoTo 10 Sheets(sh).Range("A11:U3000").ClearContents 10 Next sh (3) وهذا إختصار لكود الأستاذ الجليل خبور خير وقد جربته ويعمل بنجاح For a = 11 To [a3000].End(xlUp).Row If Cells(a, 1) <> "" Then MySheets = Cells(a, 1) Range(Cells(a, 1), Cells(a, 40)).Copy Sheets(MySheets).[a3000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End If Next a Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" (4) وهذه الأسطر القادمة تخبرك بعدد ماتم نقله x1 = Sheets("ناجحة ومنقولة").[a3000].End(xlUp).Row - 10 x2 = Sheets("لها دور ثان").[a3000].End(xlUp).Row - 10 MsgBox ("تم ترحيل عدد " & x1 & " طالبة لناجحة ومنقولة" & Chr(10) & "وترحيل عدد " & x2 & "طالبة لها دور ثان ") (5) طلبك الأخير لم أفهمه تحديد إسم العمود أو رقمه الذى يحتوى الدليل أو البيان الذى سيستخدم للترحيل تفضل المرفق الف شكر استاذنا العزيز ومراقبنا العام طارق بك جازاك الله خيراً بالنسبة لكود المسح المفروض يتم تطبيقه فى الشيتات التى تم الترحيل فيها وليس كل شيتات الملف فالملف الفعلى يتكون من حوالى 20 شيت ولو تم مس هذا المجال فيها باظت النتيجة وإتمسحت من الأساس بالنسبة للإحصائية بعد الترحيل هل ستكون فقط قاصرة على المتغيرين (ناجحة ومنقولة ولها دور ثان ) ؟؟ أم لو كانت هناك فئة ثالثة مثلاً ( ليس لها حق الإعادة ) سيتم عرض إحصائياتها كذلك ؟؟ بالنسبة للطلب الثالث أريد معرفة ما الجزء الذى ينبغى تغييره فى الكود لو أردت أن أجعل ديناميكية الترحيل تتم بناء على متغيرات فى العمود X مثلاً بدلاً من المتغيرات الحالية فى العمود A مرة أخرى اشكرك جزيل الشكر وجارى تجربة الكود الجديد أعتذر لو أزعجتك يا غالى
يوسف عطا قام بنشر نوفمبر 16, 2011 الكاتب قام بنشر نوفمبر 16, 2011 (معدل) بعد التجربة الكود يعمل 100 مية كما تفضلت سيادتكم وذكرت طارق بك ولكن كما قلت لسيادتكم فى المشاركة السابقة المطلوب أن عملية المسح المشار إليها فى بداية الكود تطبق فقط على الشيتات التى سيتم ترحيل البيانات إليها وليس على كل شيتات الملف لأنه يتكون من عدد كبير من الشيتات تحتوى على كثير من البيانات الهامة التى لا يجب أن يتم مسحها فعملية المسح قبل تنفيذ الكود الهدف منها عدم تكرار ترحيل نفس البيانات لو كبسنا على زر الترحيل أكثر من مرة بالنسبة لعملية الإحصاء لم يتم إحصاء البيانات إلا فى الشيتين فقط المشار إليهما بالمتغيرين الأول والثانى ولما أضفت شيتات جديدة تم الترحيل إليها مظبوطاً ولكن لم تظهر إحصائياتها الحمدلله قمت بضبط هذه الجزئية بإضافة بسيطة على سطر كود الإحصاء لى طلب آخر وأعتذر مقدماً عن إضافة طلب جديد فى عمود المسلسل الترحيل يتم بنفس المسلسل الأصلى الموجود فى شيت النتيجة والمطلوب أن يتم عمل مسلسل جديد للبيانات التى تم ترحيلها كل حسب نوعه أتعشم ألا أكون ضايقتك بكثرة طلباتى شاكر لك أخى الكريم تم تعديل نوفمبر 16, 2011 بواسطه يوسف عطا
طارق محمود قام بنشر نوفمبر 17, 2011 قام بنشر نوفمبر 17, 2011 السلام عليكم بعد التجربة الكود يعمل 100 مية كما تفضلت سيادتكم وذكرت طارق بك الحمد لله المطلوب أن عملية المسح المشار إليها فى بداية الكود تطبق فقط على الشيتات التى سيتم ترحيل البيانات إليها وليس على كل شيتات الملف لأنه يتكون من عدد كبير من الشيتات تحتوى على كثير من البيانات الهامة التى لا يجب أن يتم مسحها فعملية المسح قبل تنفيذ الكود الهدف منها عدم تكرار ترحيل نفس البيانات لو كبسنا على زر الترحيل أكثر من مرة سهلة إن شاء الله ولكن ليس عندي وقت قبل السبت صبر جميل بالنسبة لعملية الإحصاء لم يتم إحصاء البيانات إلا فى الشيتين فقط المشار إليهما بالمتغيرين الأول والثانى ولما أضفت شيتات جديدة تم الترحيل إليها مظبوطاً ولكن لم تظهر إحصائياتها الحمدلله قمت بضبط هذه الجزئية بإضافة بسيطة على سطر كود الإحصاء كنت سأطلب منك ذلك ، الحمد لله لى طلب آخر فى عمود المسلسل الترحيل يتم بنفس المسلسل الأصلى الموجود فى شيت النتيجة والمطلوب أن يتم عمل مسلسل جديد للبيانات التى تم ترحيلها كل حسب نوعه سهلة أيضا إن شاء الله ولكن إلي السبت
يوسف عطا قام بنشر نوفمبر 17, 2011 الكاتب قام بنشر نوفمبر 17, 2011 (معدل) مراقبنا العام طارق بك الف شكر على كرمك البالغ إنا لصابرون ونسأل الله أن يوسع فى وقتك ورزقك بالنسبة لتعديل سطر الإحصاء فى الكود لقد عدلته كما يلى ولى سؤال x1 = Sheets("ناجحة ومنقولة").[a3000].End(xlUp).Row - 10 x2 = Sheets("لها دور ثان").[a3000].End(xlUp).Row - 10 x3 = Sheets("لها حق الإعادة").[a3000].End(xlUp).Row - 10 x4 = Sheets("ليس لها حق الإعادة").[a3000].End(xlUp).Row - 10 MsgBox (" تم ترحيل عدد" & x1 & " طالبة ناجحة ومنقولة" & Chr(10) & "وترحيل عدد " & x2 & " طالبة لها دور ثان " & Chr(10) & " و ترحيل عدد" & x3 & " طالبة لها حق الإعادة" & Chr(10) & "وترحيل عدد " & x4 & " طالبة ليس لها حق الإعادة ") Range("a1").Select ما هى دلالة هذه الجزيئية & Chr(10) & وهل ما قمت به تمام ولا يحتاج تنقيح من سيادتكم ؟؟ ومرفق الملف بعد حذف جزء المسح وتعديل جزء التكرار ترحيل معدل بدون مسح.rar ترحيل معدل بدون مسح.rar تم تعديل نوفمبر 17, 2011 بواسطه يوسف عطا
طارق محمود قام بنشر نوفمبر 19, 2011 قام بنشر نوفمبر 19, 2011 السلام عليكم ما هى دلالة هذه الجزيئية & Chr(10) & الدالة CHR في الفيجوال بيزيك هي نفسها CHAR في الإكسيل وهي ترجع عادة شكل الحرف أو الرقم الذي كوده يساوي كذا وهي تستخدم أيضا للأحرف الخاصة أو التحكم مثلا الحرف رقم 10 كما في مثالنا يفعل فعل كبسة الإنتر Enter بمعني أن إذا لديك بيانين في الطباعة كما في حالنا هذا وتريد لكل بيان منهما أن يظهر في سطر منفصل في الصندوق الحواري MSG فتضع بينهما & Chr(10) &
mhrrd قام بنشر نوفمبر 19, 2011 قام بنشر نوفمبر 19, 2011 (معدل) جزاكم الله خيرا تم تعديل نوفمبر 19, 2011 بواسطه mhrrd
طارق محمود قام بنشر نوفمبر 19, 2011 قام بنشر نوفمبر 19, 2011 السلام عليكم أخي الحبيب هذا هو الكود بعد التعديل Sub Tareqتعديل_ترحيل() '============================================= On Error Resume Next Application.ScreenUpdating = False 'الجزء التالي يحفظ أسماء جميع الحالات الموجودة في العمود الأول rg1 = "A11:A" & [A3000].End(xlUp).Row Range(rg1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("X11"), Unique:=True Dim sht(9) As String, x(9) As Integer case_NO = [x100].End(xlUp).Row - 11 For i = 1 To case_NO sht(i) = Cells(11 + i, "X") Next i Range("X11:X" & 12 + case_NO).ClearContents 'الجزء التالي يمسح فقط المجال المطلوب من الشيتات التي أسماؤها مسجلة في الجزء السابق For sh = 1 To Sheets.Count For i = 1 To case_NO If Sheets(sh).Name = sht(i) Then Sheets(sh).Range("A11:U3000").ClearContents Next i Next sh 'وهناأصل البرنامج For a = 11 To [A3000].End(xlUp).Row If Cells(a, 1) <> "" Then MySheets = Cells(a, 1) Range(Cells(a, 1), Cells(a, 40)).Copy Sheets(MySheets).[A3000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End If Next a Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" ' وهنا تطوير طفيف ليلائم العدد المتغير للحالات For i = 1 To case_NO x(i) = Sheets(sht(i)).[A3000].End(xlUp).Row - 10 mssg = mssg & Chr(10) & x(i) & " " & sht(i) Next i MsgBox (" تم ترحيل عدد" & mssg) Range("a1").Select ' وأخيرا هذا الجزء لضبط المسلسل في الشيتات التي حدث الترحيل إليها For i = 1 To case_NO Sheets(sht(i)).[B11] = 1 For Each cc In Sheets(sht(i)).Range("B12:B" & [B3000].End(xlUp).Row) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next i On Error Resume Next On Error GoTo 0 End Sub وهذا المرفق تفضل ترحيل معدل بدون مسح2.rar
يوسف عطا قام بنشر نوفمبر 19, 2011 الكاتب قام بنشر نوفمبر 19, 2011 لا حرمنا الله من مساعداتك أخونا المراقب العام ربنا يجعل أعمالك فى ميزان حسناتك جارى تجريب المرفق آخر سؤال ولا تزعل من كثرة طلباتى ربنا يجعلك من مجيبى السائلين لو عاوز أغير مكان العمود الذى يتم على اساسه الترحيل أة جزء أغيره فى الكود لكى يرحل مثلاً البيانات التى يوجد بجوارها فى عمود Y ناجحة ومنقولة أو لها دور ثان علماً بأن هذه التصنيفات حالياً فى العمود A وأنا أريد تغيير مكانها للعمود Y أعتذر مرة أخرى لإزعاجك
يوسف عطا قام بنشر نوفمبر 19, 2011 الكاتب قام بنشر نوفمبر 19, 2011 الله ينور يا غالى كود رائع ويعمل بلا أى مشاكل وسريع ودقيق فقط نقطة واحدة ليست ذات أهمية كبرى السلسلة فى الشيتات المرحل إليها تستمر حتى رقم 2000 والمفروض تنتهى عند آخر بيان تم ترحيله فى كل شيت لو وقتك يسمح بالتعديل أوكى ولو لا يسمح برضه أوكى فقد تم إنجاز العمل المطلوب والباقى مجرد رتوش لا تؤثر فى جودة العمل دمت بكل ود أخى الغالى طارق بك
mhrrd قام بنشر نوفمبر 19, 2011 قام بنشر نوفمبر 19, 2011 الاستاذ طارق المحترم السلام عليكم ورحمة الله جزاك الله كل خير وبعد : لو عاوز أغير مكان العمود الذى يتم على اساسه الترحيل لو عايز الكود ينقل عدد معين من الاعمده اي جزئيه اغيرها وبارك الله لك
طارق محمود قام بنشر نوفمبر 20, 2011 قام بنشر نوفمبر 20, 2011 السلام عليكم اخي يوسف السلسلة فى الشيتات المرحل إليها تستمر حتى رقم 2000 والمفروض تنتهى عند آخر بيان تم ترحيله فى كل شيت فقط عدل الجزء الأخير من الكود بدلا من ' وأخيرا هذا الجزء لضبط المسلسل في الشيتات التي حدث الترحيل إليها For i = 1 To case_NO Sheets(sht(i)).[B11] = 1 For Each cc In Sheets(sht(i)).Range("B12:B" & [B3000].End(xlUp).Row) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next i ليكون ' وأخيرا هذا الجزء لضبط المسلسل في الشيتات التي حدث الترحيل إليها For i = 1 To case_NO Sheets(sht(i)).[B11] = 1 rrw = Sheets(sht(i)).[B3000].End(xlUp).Row For Each cc In Sheets(sht(i)).Range("B12:B" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next i
يوسف عطا قام بنشر نوفمبر 20, 2011 الكاتب قام بنشر نوفمبر 20, 2011 لا حرمنا الله منك أستاذنا المحترم ومراقبنا العام جارى تطبيق التعديل
طارق محمود قام بنشر نوفمبر 20, 2011 قام بنشر نوفمبر 20, 2011 السلام عليكم أخي العزيز / mhrrd لو عاوز أغير مكان العمود الذى يتم على اساسه الترحيل لو عايز الكود ينقل عدد معين من الاعمده اي جزئيه اغيرها التغيير يكون في هذه الجزئية 'وهناأصل البرنامج For a = 11 To [A3000].End(xlUp).Row If Cells(a, 1) <> "" Then MySheets = Cells(a, 1) Range(Cells(a, 1), Cells(a, 40)).Copy Sheets(MySheets).[A3000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues End If Next a Range(Cells(a, 1), Cells(a, 40)).Copy ' هذا السطر يأخذ نسخة من العمود الأول للعمود الأربعين Range(Cells(a, 1), Cells(a, 7)).Copy ' يمكنك إستبدال الرقم 40 بالرقم الذي تريد في حالة أن يكون المطلوب نقل أول أعمدة مثلا من الأول للسابع ' ولكن إن كنت تريد نقل أجزاء متفرقة مثلا الأعمدة من الأول للسابع مع الأعمدة من العشرين للخامس والعشرين فتغيره بما يلي Union(Range(Cells(a, 1), Cells(a, 7)), Range(Cells(a, 20), Cells(2, 25))).Copy أرجو تكون الفكرة واضحة
يوسف عطا قام بنشر نوفمبر 20, 2011 الكاتب قام بنشر نوفمبر 20, 2011 الله ينور عليك أخونا الغالى الكود أصبح ممتزاً جداً ويؤدى كل ما هو مطلوب ربنا يجعله فى ميزان حسناتك باقى فقط الإستفسار بشأن أى جزء فى الكود يجب تعديله لتغيير إسم العمود الذى يستخدم لترحيل البيانات للعمود Y بدلاً من العمود A المستخدم حالياً
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.