دمج بيانات عدة اعمدة فى عمود بدون فراغات وبدون تكرارات

[abouelhassan]

السلام عليكم اساتذتى الافاضل

احتاج تجميع بيانات عدد 5 اعمدة فى عمود بدون تكرار الاسماء ةبدون فراغات

مع الشكر والتقدير والاحترام

تجميع بيانات بدون فراغات او تكرار.xlsm

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

جرب هذا الكود

Option Explicit
Dim x%, y%
Dim Dic As Object
Dim Sh As Worksheet
Dim My_rg As Range

Sub All_in_One()
Application.ScreenUpdating = False
Set Sh = Sheets("Sheet1")
Set Dic = CreateObject("Scripting.Dictionary")

With Sh
.Range("H1").CurrentRegion.Clear
 For y = 1 To .Range("A1").CurrentRegion.Columns.Count
    For x = 2 To _
     .Range("A1").CurrentRegion.Rows.Count
     If .Cells(x, y) <> "" Then
      Dic(.Cells(x, y).Value) = ""
     End If
    Next x
 Next y
 If Dic.Count = 0 Then GoTo Bay_Bay
 .Range("H1") = "ALL"
 .Range("H2").Resize(Dic.Count) = _
 Application.Transpose(Dic.keys)
  If .Range("H1").CurrentRegion.Rows.Count > 1 Then
   With .Range("H1").CurrentRegion
    .Borders.LineStyle = 1
    .Font.Bold = True: .Font.Size = 14
    .InsertIndent 1
    .Interior.ColorIndex = 35
    .Cells(1, 1).Interior.ColorIndex = 6
    End With
  End If
 End With
Bay_Bay:
 Set Sh = Nothing
 Set Dic = Nothing
 Application.ScreenUpdating = True
End Sub

الكلف مرفق

abou_has_All_in_one.xlsm

[abouelhassan]

ربنا يحفظك يارب استاذى استاذ سليم 

كل الشكر والاجترام والتقدير

بارك الله فيك 

ربنا يبارك فى عمرك يا رب