(تمت الاجابة) طلب تعديل كود ترحيل

**يوسف عطا** · نوفمبر 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

إضافة أخرى لو تكرمتم يا أفاضل

أريد أن يقوم الكود بعد الترحيل أن يخبرنى تم ترحيل عدد كذا لشيت كذا وعدد كذا لشيت كذا وعدد كذا لشيت كذا حسب البيانات التى تم ترحيلها

أى بإختصار يقوم الكود بإخراج ويندو إحصاء للبيانات التى تم ترحيلها

أتعشم وصلت الفكرة

دمتم بود

**يوسف عطا** · نوفمبر 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

الف شكر عبدالله بك المجرب

سأجرب الكود بعد إختصاره

وسأحاول رفع ملف مختصر لأن الملف الأصلى حجمه 40 ميجا بعد الضغط

وهذا ما جعلنى لا أرفق ملف منذ البداية

الف شكر وأتمنى التواصل فى الموضوع بإستمرار

**يوسف عطا** · نوفمبر 11, 2011

أخى الغالى عبدالله المجرب

دام فضلك

للأسف الكود بعد إختصاره لا يعمل

إليك الملف المختصر 3 شيتات فقط ( الملف الأصلى 20 شيت ملئ بالمعادلات والأكواد والتنسيقات مما يجعل رفعه بالمنتدى أمر صعب )

تم وضع الكود الأصلى والكود المختصر الذى تفضلت حضرتك بتعديله

كذلك كود لمسح البيانات التى تم ترحيلها لإعادة الترحيل مرة أخرى دون تكرارها

الرجاء الإفادة أفادكم الله

سأركز طلباتى مرة أخرى للتذكرة

1. أن يقوم الكود بمسح البيانات التى سبق ترحيلها قبل الترحيل الجديد

2. إخراج ويندو إحصاء للبيانات التى تم ترحيلها بعد إتمام الترحيل بنجاح أو بالبيانات التى لم ترحل

3. أن أحدد إسم العمود أو رقمه الذى يحتوى الدليل أو البيان الذى سيستخدم للترحيل

ترحيل معدل.rar

**يوسف عطا** · نوفمبر 11, 2011

للرفع رفع الله قدركم

**يوسف عطا** · نوفمبر 12, 2011

للرفع للضرورة

مشكورين

**يوسف عطا** · نوفمبر 14, 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

السلام عليكم

أخي الحبيب

تفضل المرفق وبه كود معدل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

بعد التجربة الكود يعمل 100 مية كما تفضلت سيادتكم وذكرت طارق بك

ولكن كما قلت لسيادتكم فى المشاركة السابقة

المطلوب أن عملية المسح المشار إليها فى بداية الكود تطبق فقط على الشيتات التى سيتم ترحيل البيانات إليها وليس على كل شيتات الملف لأنه يتكون من عدد كبير من الشيتات تحتوى على كثير من البيانات الهامة التى لا يجب أن يتم مسحها فعملية المسح قبل تنفيذ الكود الهدف منها عدم تكرار ترحيل نفس البيانات لو كبسنا على زر الترحيل أكثر من مرة

بالنسبة لعملية الإحصاء لم يتم إحصاء البيانات إلا فى الشيتين فقط المشار إليهما بالمتغيرين الأول والثانى ولما أضفت شيتات جديدة تم الترحيل إليها مظبوطاً ولكن لم تظهر إحصائياتها

الحمدلله قمت بضبط هذه الجزئية بإضافة بسيطة على سطر كود الإحصاء

لى طلب آخر وأعتذر مقدماً عن إضافة طلب جديد

فى عمود المسلسل الترحيل يتم بنفس المسلسل الأصلى الموجود فى شيت النتيجة والمطلوب أن يتم عمل مسلسل جديد للبيانات التى تم ترحيلها كل حسب نوعه

أتعشم ألا أكون ضايقتك بكثرة طلباتى

شاكر لك أخى الكريم

تم تعديل نوفمبر 16, 2011 بواسطه يوسف عطا

**طارق محمود** · نوفمبر 17, 2011

السلام عليكم

بعد التجربة الكود يعمل 100 مية كما تفضلت سيادتكم وذكرت طارق بك

الحمد لله

المطلوب أن عملية المسح المشار إليها فى بداية الكود تطبق فقط على الشيتات التى سيتم ترحيل البيانات إليها وليس على كل شيتات الملف لأنه يتكون من عدد كبير من الشيتات تحتوى على كثير من البيانات الهامة التى لا يجب أن يتم مسحها فعملية المسح قبل تنفيذ الكود الهدف منها عدم تكرار ترحيل نفس البيانات لو كبسنا على زر الترحيل أكثر من مرة

سهلة إن شاء الله ولكن ليس عندي وقت قبل السبت صبر جميل

بالنسبة لعملية الإحصاء لم يتم إحصاء البيانات إلا فى الشيتين فقط المشار إليهما بالمتغيرين الأول والثانى ولما أضفت شيتات جديدة تم الترحيل إليها مظبوطاً ولكن لم تظهر إحصائياتها
الحمدلله قمت بضبط هذه الجزئية بإضافة بسيطة على سطر كود الإحصاء

كنت سأطلب منك ذلك ، الحمد لله

لى طلب آخر فى عمود المسلسل الترحيل يتم بنفس المسلسل الأصلى الموجود فى شيت النتيجة والمطلوب أن يتم عمل مسلسل جديد للبيانات التى تم ترحيلها كل حسب نوعه

سهلة أيضا إن شاء الله ولكن إلي السبت

**يوسف عطا** · نوفمبر 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

تم تعديل نوفمبر 17, 2011 بواسطه يوسف عطا

**طارق محمود** · نوفمبر 19, 2011

السلام عليكم

ما هى دلالة هذه الجزيئية & Chr(10) &

الدالة CHR في الفيجوال بيزيك هي نفسها CHAR في الإكسيل وهي ترجع عادة شكل الحرف أو الرقم الذي كوده يساوي كذا

وهي تستخدم أيضا للأحرف الخاصة أو التحكم

مثلا الحرف رقم 10 كما في مثالنا يفعل فعل كبسة الإنتر Enter

بمعني أن إذا لديك بيانين في الطباعة كما في حالنا هذا وتريد لكل بيان منهما أن يظهر في سطر منفصل في الصندوق الحواري MSG فتضع بينهما

& Chr(10) &

mhrrd · نوفمبر 19, 2011

جزاكم الله خيرا

تم تعديل نوفمبر 19, 2011 بواسطه mhrrd

**طارق محمود** · نوفمبر 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

لا حرمنا الله من مساعداتك أخونا المراقب العام

ربنا يجعل أعمالك فى ميزان حسناتك

جارى تجريب المرفق

آخر سؤال ولا تزعل من كثرة طلباتى ربنا يجعلك من مجيبى السائلين

لو عاوز أغير مكان العمود الذى يتم على اساسه الترحيل

أة جزء أغيره فى الكود لكى يرحل مثلاً البيانات التى يوجد بجوارها فى عمود Y ناجحة ومنقولة أو لها دور ثان

علماً بأن هذه التصنيفات حالياً فى العمود A وأنا أريد تغيير مكانها للعمود Y

أعتذر مرة أخرى لإزعاجك

**يوسف عطا** · نوفمبر 19, 2011

الله ينور يا غالى

كود رائع ويعمل بلا أى مشاكل

وسريع ودقيق

فقط نقطة واحدة ليست ذات أهمية كبرى السلسلة فى الشيتات المرحل إليها تستمر حتى رقم 2000 والمفروض تنتهى عند آخر بيان تم ترحيله فى كل شيت

لو وقتك يسمح بالتعديل أوكى ولو لا يسمح برضه أوكى فقد تم إنجاز العمل المطلوب والباقى مجرد رتوش لا تؤثر فى جودة العمل

دمت بكل ود أخى الغالى طارق بك

mhrrd · نوفمبر 19, 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

السلام عليكم

أخي العزيز / 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

الله ينور عليك أخونا الغالى الكود أصبح ممتزاً جداً ويؤدى كل ما هو مطلوب

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

باقى فقط الإستفسار بشأن أى جزء فى الكود يجب تعديله لتغيير إسم العمود الذى يستخدم لترحيل البيانات للعمود Y بدلاً من العمود A المستخدم حالياً

تسجيل الدخول

(تمت الاجابة) طلب تعديل كود ترحيل

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

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

من فضلك سجل دخول لتتمكن من التعليق

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information