بعض طرق ترحيل البيانات

بسم الله الرحمن الرحيم
نقدم لكم اليوم بعض طرق ترحيل البيانات من شيت لاخر

الصورة مصغرة أنقر هنا لرؤيتها بحجمها الطبيعي 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  

لتحميل المثال للثلاث طرق اضغط هنا

تحياتي

اعداد / ياسر العربي

عن أكاديمية الصقر للتدريب

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

شاهد أيضاً

برنامج المخازن Ystore – ياسر العربي معدل

بسم الله الرحمن الرحيم تم عمل تعديل لبرنامج Ystoreواصلاح اغلب المشكلات التي كانت موجودة مسبقالتحميل …

اترك تعليقاً

لن يتم نشر عنوان بريدك الإلكتروني. الحقول الإلزامية مشار إليها بـ *