المساعدة في ايجاد معادلة

[nofal.saad]

السلام عليكم

يرجى المساعدة في ايجاد معادلة بحيث تكتب كل البيانات الرقمية الموجودة في عدة اعمدة لكتابتها في عمود واحد , بحيث عندما تنتهي بيانات العمود الاول تنتقل المعادلة لجلب محتويات العمود الثاني و هكذا.

يرجى مشاهدة الملف المرفق للتوضيح

 

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

New Microsoft Excel Worksheet (2).xlsx

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

جرب هذا الماكرو

Option Explicit
Sub All_in_on()
With Sheets("sheet1")
    Dim my_rg As Range, N_col%, N_Row%, x%
    Dim t%, k%: k = 2
    Set my_rg = .Range("a2").CurrentRegion
    .Range("j2", Range("j1").End(4)).ClearContents
    N_col = my_rg.Columns.Count
    N_Row = my_rg.Rows.Count
     For x = 1 To N_col
         For t = 1 To N_Row
            If Not IsEmpty(my_rg.Cells(t, x)) Then
              .Cells(k, "J") = my_rg.Cells(t, x)
              k = k + 1
            End If
         Next
       Next
 End With
End Sub

الملف مرفق

Write_in_one_col.xlsm

[Ali Mohamed Ali]

عمل رائع بارك الله فيك أستاذ سليم

[بن علية حاجي]

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

وهذا كود آخر في المرفق يقوم بجمع قيم خلايا الأعمدة من A إلى F في العمود M بداية من الصف الثاني مع نسخ لون خلايا هذه القيم (والكود لا يعتبر الخلايا الفارغة في الأعمودة)...

بن علية حاجي

New Microsoft Excel Worksheet (1).xlsm

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

رائع استاذ بن علية

لكن اذا كنت تريد نقل التنسيق ايضاً يمكن استعمال هذا الكود     حلقة تكرارية واحدة (ربما يكون أسرع للبيانات الكبيرة)

مع امكانية ادراج صف فارغ أو لا (بعد نسخ البيانات) من خلال الاجابة عن سؤال   Yes  Or  No

Option Explicit

Sub All_in_on_New()
With Sheets("Sheet1")
    Dim my_rg As Range, N_col%, x%
    Dim k%: k = 2
    Dim sub_rg As Range
    Dim Answer As Byte
    .Range("j2:j" & Rows.Count).Clear
    Set my_rg = .Range("a2").CurrentRegion
   
    N_col = my_rg.Columns.Count
    Answer = MsgBox(" Your Data With Empty Row Between Or NO??", 4)
    
    For x = 1 To N_col
      Set sub_rg = my_rg.Columns(x).SpecialCells(2, 23)
      sub_rg.Copy Cells(k, "j")
       k = k + sub_rg.Cells.Count + (7 - Answer)
    Next
 End With
End Sub

الملف مرفق

 

Write_in_one_co_New.xlsm

[nofal.saad]

😥بوركت جهودكم

عمل رائع ماشاء الله

شكرا جزيلا