المساعدة فى ترحيل بيانات من صفحة الى صفحة اخرى

[ابو سما]

اخوانى واصدقائى 

السلام عليكم ورحمة الله وبركاتة

ارجوا منكم اخواتى مساعدتى فى الملف المرفق حيث ياتى لى ملف بة الاصناف التى تم صرفها من مخزن الادوات الكتابية على شكل كود الصنف واسمة والكمية والقيمة لمجموعة اصناف ومطلوب منى شهريا ان اضعها فى الشهر الذى يخصها بال Sheet 1 بحيث توضع الكمية والقيمة للاصناف الموجودة بال Sheet 2 بالفعل فى الشهر الذى يخصة ام الصنف الجديد يوضع الاول بياناتة وهى الكود واسم الصنف وبعد ذلك اذهب للشهر الذى يخصة واضع الكمية والقيمة لذا ارجوا من اخواتى واصدقائى مساعدتى فى ترحيل هذة العمليات بزر واحد لان الاصناف كثيرة بالفعل وتاخذ وقت طويل واشكرلكم شكر كثير واعتذر على الاطالة

منصرف المخزن.xlsx

تم تعديل فبراير 3, 2019 بواسطه ابو سما

[سليم حاصبيا]

جرب هذا الماكرو

Option Explicit

Sub Transfere()
Dim X, y
Dim old_val1#, New_vaL1#
Dim old_val2#, New_vaL2#
Dim i%
i = 3
Dim k%
Do Until Sheets("Sheet2").Range("b" & i) = ""

X = Application.Match(Sheets("Sheet2").Range("b" & i), Sheets("sheet1").Range("B:B"), 0)
New_vaL1 = Sheets("Sheet2").Range("b" & i).Offset(, 1)
New_vaL2 = Sheets("Sheet2").Range("b" & i).Offset(, 2)

 y = Application.Match(Sheets("sheet2").Range("c1"), Sheets("sheet1").Rows("1"), 0)
 old_val1 = Sheets("sheet1").Cells(X, y): old_val2 = Sheets("sheet1").Cells(X, y + 1)
 Sheets("sheet1").Cells(X, y) = old_val1 + New_vaL1
 Sheets("sheet1").Cells(X, y + 1) = old_val2 + New_vaL2
i = i + 1
Loop
End Sub

الملف مرفق

 

Salim_Magazine.xlsm

[Ali Mohamed Ali]

احسنت استاذ سليم كود ممتاز جعله الله فى ميزان حسناتك

[Abo Sufiyan]

ا/ سليم 

الكود اكثر من رائع ولكن عند استخدامة يقوم بترحيل الاصناف الموجودة بالفعل فى Sheet 1 ولكن الاصناف الجديدة لا تنزل بياناتها وكمياتها

تم تعديل فبراير 4, 2019 بواسطه ابو سارة

[سليم حاصبيا]

تم التعديل (عند اضاقة اي صتف سوف يرحل تلقائياُ) مع بياناته

و يتم تصفير البيانات من جديد

Option Explicit

Sub Transfere()
Dim X, y
Dim old_val1#, New_vaL1#
Dim old_val2#, New_vaL2#
Dim i%: i = 3
Dim My_row%: My_row = Sheets("Sheet2").Cells(Rows.Count, 2).End(3).Row
 
 If My_row <= 2 Then Exit Sub
  
  Sheets("Sheet1").Range("a4:b" & Rows.Count).ClearContents
  Sheets("Sheet1").Range("a4").Resize(My_row - 2, 2).Value = _
  Sheets("Sheet2").Range("a3").Resize(My_row - 2, 2).Value
Do Until Sheets("Sheet2").Range("b" & i) = vbNullString

X = Application.Match(Sheets("Sheet2").Range("b" & i), Sheets("sheet1").Range("B:B"), 0)
New_vaL1 = Sheets("Sheet2").Range("b" & i).Offset(, 1)
New_vaL2 = Sheets("Sheet2").Range("b" & i).Offset(, 2)

 y = Application.Match(Sheets("sheet2").Range("c1"), Sheets("sheet1").Rows("1"), 0)
 old_val1 = Sheets("sheet1").Cells(X, y): old_val2 = Sheets("sheet1").Cells(X, y + 1)
 Sheets("sheet1").Cells(X, y) = old_val1 + New_vaL1
 Sheets("sheet1").Cells(X, y + 1) = old_val2 + New_vaL2
  Sheets("Sheet2").Range("b" & i).Offset(, 1) = vbNullString
  Sheets("Sheet2").Range("b" & i).Offset(, 2) = vbNullString
i = i + 1
Loop
End Sub

الملف الجديد مرفق

 

 

 

Salim_Magazine_Auto.xlsm

[Abo Sufiyan]

ا/ سليم 

اشكرك جدا على الكود باستخدامة عند ترحيل شهر بالفعل يضع البيانات الجديدة ولكن فى الشهر التالى اذا كانت الاصناف غير مرتبة يقوم بوضع الترتيب الجديد فى الترحيل مع عدم تغير اماكن الكميات فى الشهر الماضى ما يعنى ان الكميات الخاصة بصنف توضع مع صنف اخر للشهر السابق 

 

واعتذر جدا على الاطالة و اشكرك جدا جدا على المجهود المبذول 

[سليم حاصبيا]

عليك ان تصفر كل البيانات في الورقة 1(فقط الاعداد ) لمرة واحدة فقط

و تبدأ من جديد لأن في الصفحة 1 يجري ما يلي

1-يتم ازالة كافة الاصناف مع الكودات الخاصة

2-يتم ادراج الاصناف المدرجة في الصفحة 2  مع الكودات الخاصة

3-كلما ادرجت صنفاً جديداً في الصفحة 2 و بعد تنفيذ الماكرو تتم اضافته الى الصفحة 1 مع الكود بنفس الترتيب

 

[Abo Sufiyan]

ا/ سليم 

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