دمج عمودين او اكثر فى عمود واحد

[المحب لمصر]

عندى اعمدة (1,2,3) هل هناك معادله تجمع بيانات هولاء الاعمدة فى عمود واحد خلف بعض مع العلم لو فى امكانية ترك سطر واحد فارغ بعد كل بيانات كل عمود كما فى المثال المرفق

 

 

المصنف2.rar

تم تعديل مايو 29, 2016 بواسطه المحب لمصر

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

جرب هذا الكود

Sub salim()
    Dim rg As Range
    Dim  m, i As Integer
Range("j8:j500").ClearContents
m = 8
        For i = 3 To 7 Step 2
            Set rg = Range(Cells(8, i), Cells(500, i)).SpecialCells(xlCellTypeConstants, 23)
              rg.Copy Cells(m, "j")
              m = m + rg.Count + 1
         Next
End Sub

 

[المحب لمصر]

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

[ياسر خليل أبو البراء]

أخي الكريم المحب لمصر (مش عارف بتحبها على ايه .. بس بيني وبينك هي تتحب أكيد )

 

امشي معايا خطوة بخطوة وحاول تنفيذ المطلوب بنفسك

بص وركز ..متبصش الناحية دي لا الناحية دي ..أيوا تمام

أول حاجة افتح الملف الخاص بك (الحمد لله أظنها سهلة الخطوة دي)

بعد ما فتحت الملف اضغط Alt + F11 هتلاقي نفسك داخل محرر الأكواد .. تمام

روح لشريط القوايم هتلاقي قايمة اسمها Insert يا سلام ولا أسهل

انقر عليها واختار منها Module هتلاقي فيه موديول عادي تم إدراجه واسمه Module1 وهتلاقي مؤشر الماوس منور قدامك داخل الموديول

في مكان المؤشر هتحط الكود اللي تقدم بيه الأخ سليم (نسخ ولصق)

بعد ما تخلص هتلاقي أيقونة على شكل أيقونة الإكسيل انقر عليها عشان ترجع لورقة العمل

احفظ الملف هيطلع لك رسالة تختار منها No مش Yes خلي بالك عشان الامتداد هيكون مختلف للملف الجديد

هيطلع لك نافذة تنقر على Browse عشان تحدد المكان اللي هيتحفظ فيه الملف

حدد المكان اللي يعجبك (اللي هو سطح المكتب عشان دا اللي عاجبني يا ابني)

واكتب أي اسم للملف الجديد أو اترك الاسم كما هو (مش هتفرق)

أهم شيء الامتداد .. خلي بالك (اختار Excel Macro-Enabled Workbook من قائمة Save As Type

وأخيراً اضغط Alt + F8 من لوحة المفاتيح هتظهر لك نافذة وهتلاقي فيها اسم الماكرو salim انقر على Run لتنفيذ الكود

 

[المحب لمصر]

في ٣٠‏/٥‏/٢٠١٦ at 08:57, ياسر خليل أبو البراء said:

أخي الكريم المحب لمصر (مش عارف بتحبها على ايه .. بس بيني وبينك هي تتحب أكيد )

 

امشي معايا خطوة بخطوة وحاول تنفيذ المطلوب بنفسك

بص وركز ..متبصش الناحية دي لا الناحية دي ..أيوا تمام

أول حاجة افتح الملف الخاص بك (الحمد لله أظنها سهلة الخطوة دي)

بعد ما فتحت الملف اضغط Alt + F11 هتلاقي نفسك داخل محرر الأكواد .. تمام

روح لشريط القوايم هتلاقي قايمة اسمها Insert يا سلام ولا أسهل

انقر عليها واختار منها Module هتلاقي فيه موديول عادي تم إدراجه واسمه Module1 وهتلاقي مؤشر الماوس منور قدامك داخل الموديول

في مكان المؤشر هتحط الكود اللي تقدم بيه الأخ سليم (نسخ ولصق)

بعد ما تخلص هتلاقي أيقونة على شكل أيقونة الإكسيل انقر عليها عشان ترجع لورقة العمل

احفظ الملف هيطلع لك رسالة تختار منها No مش Yes خلي بالك عشان الامتداد هيكون مختلف للملف الجديد

هيطلع لك نافذة تنقر على Browse عشان تحدد المكان اللي هيتحفظ فيه الملف

حدد المكان اللي يعجبك (اللي هو سطح المكتب عشان دا اللي عاجبني يا ابني)

واكتب أي اسم للملف الجديد أو اترك الاسم كما هو (مش هتفرق)

أهم شيء الامتداد .. خلي بالك (اختار Excel Macro-Enabled Workbook من قائمة Save As Type

وأخيراً اضغط Alt + F8 من لوحة المفاتيح هتظهر لك نافذة وهتلاقي فيها اسم الماكرو salim انقر على Run لتنفيذ الكود

 

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

[المحب لمصر]

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

بعد اذن الستاذة اريد شرح للسطر ده لانع سطر المعطيات واريد فهمه for i= 3 to 7 step 2  

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

اضف هذا الكود الى حدث التفيير في الصفحة مغ الاختفاظ بالكود السابق salim

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    If Target.Count = 1 And Target.Row > 7 Then
            Select Case Target.Column
                Case 3, 5, 7
                 salim
          End Select
    End If
  Application.EnableEvents = True
End Sub

 

[المحب لمصر]

استاذ /  سليم   انا فعلا عاجز عن الشكرا
بارك الله فيك اخى الكريم