جزاكم الله الف خير استاتذي
هل ممكن شرح كيف تم عمل
لان انا بدي اضيفه الى مشروع خاص بمدرستنا
والمشروع كبير جدا ولا يمكن تحميله
يوجد مشكلة عند اضافة قائمة اسماء لا يقبل التوزيع
فقط يقبل توزيع المفرد اي اكتب اسم اسم
هنالك مشكلة لايقبل ان اضيف قائمة بالكامل
اي يقبل اضافة اسم اسم فقط وليس مجموعة اسماء
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 And Target.Row > 2 _
And Target.Columns.Count = 1 Then
Dim Cell As Range
Dim Arr
For Each Cell In Target.Cells
Cell.Offset(0, 1).Resize(, 4).ClearContents
Arr = Split(Cell, " ")
On Error GoTo Next_Cell
Cell.Offset(0, 1).Resize(, 4).ClearContents
Cell.Offset(, 1).Resize(, UBound(Arr) + 1) = Arr
'==================
Next_Cell:
Erase Arr
Next
End If
Application.EnableEvents = True
End Sub
رد///////
هذا الكود يعمل بواسطة النسخ من عامود اخر(عامود واحد فقط) واللصق( في العامود A)
ابتداءً من الصف رقم 2