بسم الله الرحمن الرحيم
نقدم لكم اليوم بعض طرق ترحيل البيانات من شيت لاخر
الصورة مصغرة أنقر هنا لرؤيتها بحجمها الطبيعي 640*209
الكود الاول
اول طريقة وهي عن طريق تخزين النطاق المراد ترحيله داخل مصفوفة
ومن ثم وضعه في المكان المراد الترحيل اليه
كما موضح بالكود التالي
CODE
Sub TRans()
Dim myArray() As Variant
myArray = Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row)
Sheet2.Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray
MsgBox "DONE....", 64
End Sub
اما الكود الثاني
فهو يقوم بتحديد نطاق البيانات ومن ثم يقوم بالنسخ
ويقوم بعمل لصق خاص (القيم فقط) اي البيانات بدون اي تنسيقات او
معادلات
وتستطيع تغيير طريقة لصق البيانات كما بالصورة
منها لصق التنسيقات او لصق الجميع او لصق القيم الخ
الصورة مصغرة أنقر هنا لرؤيتها بحجمها الطبيعي 640*124
الكود كما هو موضح
CODE
Sub TRans1()
Application.ScreenUpdating = False
Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row).Copy
Sheet2.Range("B" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "DONE....", 64
End Sub
<code> </code>
الكود الثالث
يقوم بنسخ بطريقة الـ (Destination)
ويتم وضع المكان الهدف المراد النسخ له بجانب كود النسخ مباشرة
وهذا الكود يقوم بنسخ البيانات كما هي بتنسيقاتها معادلاتها
كما موضح
CODE
Sub TRans2()
Application.ScreenUpdating = False
Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row).Copy Sheet2.Range("B" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row + 1)
Application.ScreenUpdating = True
MsgBox "DONE....", 64
End Sub
لتحميل المثال للثلاث طرق اضغط هنا
تحياتي
اعداد / ياسر العربي