توزيع معدات واصناف علي 3شركات

[الدهشوري]

توزيع معدات واصناف علي شركات.xlsx

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

والشرح تفصيلي بالمرفق وجزاكم الله كل خير

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub DistData()
Dim ws As Worksheet, Sh As Worksheet
Dim i As Long, p As Long, j As Long, LR As Long
Dim Arr As Variant, Tmp As Variant
Set ws = Sheets("data")
Arr = ws.Range("A5:H" & ws.Range("B" & Rows.Count).End(3).Row).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For Each Sh In Worksheets
If Sh.Name <> ws.Name Then
For i = 1 To UBound(Arr, 1)
If Sh.Name = Arr(i, 6) Then
p = p + 1
For j = 1 To 7
Tmp(p, j) = Arr(i, Choose(j, 1, 2, 3, 4, 6, 7, 8))
Next
End If
Next
End If
If p > 0 Then Sh.Range("A5").Resize(p, UBound(Tmp, 2)).Value = Tmp
p = 0
Next
End Sub

 

[الدهشوري]

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

[ابراهيم الحداد]

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

اليك الملف جاهز 

كل ماعليك الضغط على الزر المكتوب عليه "اضغط للترحيل" فى ورقة data

 

توزيع معدات واصناف علي شركات.xlsm

[الدهشوري]

جزاك الله كل خير وجعله الله في ميزان حسناتك

الأخوة الأفاضل لو أمكن عايز ازود عامودين فى الشيت من بعد عامود البيان عامود بإسم النوع والثاني الكود

اعضاء المنتدى المحترم عند اضافه أعمدة الكود لا يعمل وجزاكم الله كل خير