ترحيل خلايا معتمد على قيم متغيرة

[محمد ابو البـراء]

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

المطلوب في الملف المرفق

 

الترحيل بشرط قيمة متغيرة.rar

[عبدالله المجرب]

 

ولكن اريد الترحيل تلقائي للخلايا على حسب العدد الذي اريدهولكن باحد المعادلات

 

 

الا تريد إستعمال الكود في الترحيل

[محمد ابو البـراء]

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

1 ) بجد اول ما طرا في دماغي الترحيل توقعت انك احد المجيبين

استاذي الحبيب عبدالله المجرب

2 ) لا ..لم اقصد عدم الحل بالمعادلات

ولعل العبارات خانتني

فما قصدته هو عدم الاعتماد على شرط العمود b

 

[عبدالله المجرب]

جرب هذا الكود

بداية قم بإزالة الدمج في الورقة 2 وكذلك امسح البيانات فيها 

ثم فعل الكود

Sub Abu_Ahmed()
Set MySh = Sheets("ورقة2")
For i = 1 To 30
If i = 1 Then
MySh.Range("A" & MySh.[A10000].End(xlUp).Row) = [D4]
MySh.Range("A" & MySh.[A10000].End(xlUp).Row & ":" & "B" & MySh.[A10000].End(xlUp).Row).Merge
End If
If i = (Val([E4]) + 1) Then
MySh.Range("A" & MySh.[A10000].End(xlUp).Row + 3) = [D5]
MySh.Range("A" & MySh.[A10000].End(xlUp).Row & ":" & "B" & MySh.[A10000].End(xlUp).Row).Merge
End If
If i = (Val([E4]) + Val([E5]) + 1) Then
MySh.Range("A" & MySh.[A10000].End(xlUp).Row + 3) = [D6]
MySh.Range("A" & MySh.[A10000].End(xlUp).Row & ":" & "B" & MySh.[A10000].End(xlUp).Row).Merge
End If
MySh.Range("A" & MySh.[A10000].End(xlUp).Row + 1) = Cells(i + 1, 1)

Next
End Sub

[محمد ابو البـراء]

بارك الله فيك أخي الاستاذ  عبد الله المجرب

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

الكود يعمل بنجاح

ولكن عند تغيير البيانات في الخلايا المتغيرة ثم اعاود الترحيل

لا يتم الترحيل الا بعد تكرار المسح مرة أخرى.. وهكذا..

[عبدالله المجرب]

هل تريد سطر المسح 

[رجب جاويش]

بعد اذن الأستاذ الفاضل / عبد الله المجرب

ولاثراء الموضوع

هذا كود بفكرة أخرى

Sub ragab()
Dim arr() As String
Set sh = Sheets("ورقة2")
sh.UsedRange.ClearContents
x = 2: Z = [E4] + 1
'================================
For R = 4 To 6
    i = Cells(R, 5) + 1
    ReDim arr(1 To i)
    arr(1) = Cells(R, 4)
    xx = 2
    For T = x To Z
        arr(xx) = Cells(T, 1)
        xx = xx + 1
    Next
    LR = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    sh.Range("A" & LR).Resize(i) = Application.WorksheetFunction.Transpose(arr)
    x = x + Cells(R, 5)
    Z = Z + Cells(R + 1, 5)
    Erase arr
Next
End Sub

1111الترحيل بشرط قيمة متغيرة.rar

[محمد ابو البـراء]

بارك الله فيك أخي الحبيب // استاذ رجب

دائما سباق ودائما متميز ورائع..

فضلا وليس امراً

ولعلك ستفهم ما اقصد

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

(كترحيل الاسماء الى القوائم _ او ترحيل الاسماء الى ارقام الجلوس - او ترحيل الاسماء الى كشوف المناداة )

_وطبعا هناك طرق ولله الحمد استطيع ان اقوم بالترحيل بها

ولكن  هذه الطرق تعتمد على وجود شرط

كما في الملف المرفق والعمود b_

ولكن

رغبتي الترحيل  يكون بشرط عدد الخلايا _ كما وضحت في المرفق _

وكما تفضلت انت والاخ عبد الله المجرب بالاكواد... وهذا تمام جدا!!!!

ولكن !!!!!

انت تعلم ان هذه الطرق لا تصلح في اعمالنا _الاعمال المدرسية _

لاننا

1 ) نحتاج الى ترحيل في اماكن محددة كما وضحت انا في المرفق في الورقة الثانية

2 ) كذلك نحتاج الى وجود بيانات ثابتة لا تتغير في بعض الخلايا

بمعني مثلا

الترحيل الاول يكون من a5 : c30

ويوجد بيانات من A31 الى C34

ثم ترحيل المتغير الثاني من a 35 : c65 وهكذا

ثم بيانات ثم المتغير الثالث ثن بيانات

ثم الرابع وهكذا..

اتمنى ان تكون وصلت الفكرة..