مساعدة في الغاء تعدد الاسطر من الخلية

[محمد 9009]

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

 

لدي ملف اكسل الخلية فيه فيها اكثر من سطر اريد ان اقسم الاسطر الى خلايا

 

يعني كل سطر اريده ان يكون في خليه مستقلة

 

جزاكم الله خير

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

أخي الكريم

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

أهلاً بك في المنتدى ونورت بين إخوانك

إن شاء الله طلبك سهل ولكن ارفق ملف للعمل عليه

تقبل تحياتي

[محمد 9009]

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

 

تمت إضافة ملف للعمل عليه وارجو كتابة التفاصيل

وجزاكم الله خير

تعدد الاسطر في الخليه.zip

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

أخي الكريم

صراحة الملف سيكون صعب التعامل معه قليلاً لأنه يحتوي على أعمدة وخلايا مدمجة والدمج عدو الأكواد ..

هل الدمج ضروري أم أنه يمكن التعديل في الملف لإزالة الدمج ..؟ كما أنه يوجد العمود D موجود وغير ظاهر ..فهل تريد العمل عليه أيضاً؟

على أساس رد سأبدأ العمل في التنفيذ إن شاء الله

[محمد 9009]

اخي الكريم أبو البراء

 

انا لدي ثلاثين نسخة من الملفات لموظفين لدي بنفس الطريقة

 

انا ارجو التوضيح في الملف المرفق وذلك من اجل ان اعمل مثلها في الملفات التي لدي

وجزاك ربي كل خير

 

 

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

سأحاول العمل عليه إن شاء الله .. المشكلة لدي في الخلايا والأعمدة المدمجة ..

الرجاء الصبر وإن شاء المولى ستجد الحل

[محمد 9009]

ومازال الانتظار من الاخوة الأعزاء والرجاء اعطائي الطريقة لانه عندي ثلاثين ملف نفس المشكله

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

هل الثلاثين ملف نفس التنسيق بالضبط ؟؟

وهل تريد الحل في نفس ورقة العمل أم في ورقة أخرى؟

أجبني ولدي الحل إن شاء الله فتابع معي

[محمد 9009]

تم إعادة كتابة الملفات يدويا

 

جزاك الله خير أبو البراء

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

عندما وضعت رد في مشاركتي السابقة انتظرتك لأكثر من نصف ساعة ولم ترد فنسيت إرفاق الملف ..عموماً لعله خير

وهذا هو  الحل ..رغم إني أعتقد أنه لا حاجة لك به طالما أن الأمر قد انتهى وتم

Sub Split_Multi_Lines()
    Dim a, I As Long, II As Long, X, Rng As Range
    Dim myRows As Long, N As Long, Txt As String
    
    Application.ScreenUpdating = False
        With Sheets("Sheet1").[B2].CurrentRegion
            Set Rng = .Offset(.Rows.Count + 3).Cells(1)
            Rng.CurrentRegion.Clear
            .Copy Rng
        End With
        
        With Rng.CurrentRegion
            a = .Value
            Txt = Join(Application.Transpose(.Columns(1).Value), vbLf)
            myRows = Len(Txt) - Len(Replace(Txt, vbLf, "")): N = 2
            .Rows(2).Copy .Rows(3).Resize(myRows - 1)
            
            For I = 2 To UBound(a, 1)
                For II = 1 To UBound(a, 2)
                    If a(I, II) <> "" Then
                        X = Split(a(I, II), vbLf)
                        .Cells(N, II).Resize(UBound(X) + 1).Value = Application.Transpose(X)
                    End If
                Next
                N = N + UBound(Split(a(I, 1), vbLf)) + 1
            Next I
            
            .Rows.AutoFit
        End With
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

[محمد 9009]

جزاك الله كل خير اخي ياسر واسعدك الله

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

بعد اذن اخي الحبيب ياسر 

هذا الملف (ارجو ان ينال الاعجاب)

 

Split-Cells.rar

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

تم تنزيل الماكرو على المرفق

 

تعدد الاسطر في الخليه salim.rar