سليم حاصبيا

هذه المعالة واسحب نزولاً (لا تحصل على نتيجة الا اذا كانت الخلية F و الخلية G غير فارغتين وتحتوي اعداداً فقط) =IF(OR(NOT(ISNUMBER(F8)),NOT(ISNUMBER(G8))),"",G8*F8) الملف مرفق Alpha.xlsx

لك ما تريد لا احد يستطيع تحديد اي خلية في اول 3 أعمدة Protect_3_columns.xlsm

جرب هذا الملف My_Book10.xlsx

تم التعديل Unit _and_backs-1.xlsx

كان من المفروض رفع ملف للمعاجة لكن يمكن الاستفادة من هذا الملف Unit _and_backs.xlsx

لا تنتظر الاجابة يدون ملف مرفق

مع انك لم ترفق ملفاً للمعاينة جرب هذا الملف Wajba.xlsx

اذا اردت ان تحدد الصفوف المكررة في جدول ما اليك هذا الملف Find_dup_rows.xlsm

لقد وضعت ملفاً بهذا الموضوع قبل ان ترفع مثالك ارجو ان يكون المطلوب الكود Option Explicit Sub Copy_By_Choise() Rem Created By Salim Hasbays On 1/3/2020 Application.ScreenUpdating = False On Error GoTo End_Me Dim S As Worksheet, T As Worksheet Dim i%, col%, X%, Last%, m%, k%, Howmay_row% Dim Title_arr Set S = Sheets("Source"): Set T = Sheets("Target") col = T.Cells(2, Columns.Count).End(1).Column If col = 1 Then col = 500 Howmay_row = S.Range("G2") Title_arr = Application.Transpose(S.Range("a1:d1")) Title_arr = Application.Transpose(Title_arr) Last = S.Cells(Rows.Count, 2).End(3).Row T.Range("A2").Resize(Last, col).Clear m = 3: k = 1 For i = 2 To Last For X = 0 To 3 T.Cells(m, k).Offset(, X) = _ S.Cells(i, 1).Offset(, X) Next X m = m + 1 If m Mod (Howmay_row + 3) = 0 Then m = 3: k = k + 5 Next i col = T.Cells(3, Columns.Count).End(1).Column For k = 1 To col Step 5 Cells(2, k).Resize(, 4) = Title_arr With T.Range("B2").Offset(, k - 1).CurrentRegion .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 End With Next Erase Title_arr: Set S = Nothing: Set T = Nothing End_Me: Application.ScreenUpdating = True End Sub الملف مرفق Split_table.xlsm

ارفع مثالاَ عما تريده

جرب هذا الملف الصفحيتن Sheet1 & Salim HOW_many_letters.xlsm

جرب هذا الملف FInd_common_numbers.xlsm

شكراً استاذ محسن و لي انا بهذا الشأن هذا الماكرو (عسى ان ينال الإعجاب) Option Explicit Sub S_H_Test_NEW() Dim D As Worksheet: Set D = Sheets("Data") Dim M As Worksheet: Set M = Sheets("المطلوب") Dim ARR(): ARR = Array("S", "G", "C", "H") Dim Obj As Object, i%, Chek%, t% Set Obj = CreateObject("Scripting.Dictionary") M.Range("K2").CurrentRegion.ClearContents i = 2 Do Until D.Range("F" & i) = vbNullString For t = 1 To 4 Chek = Chek + (UCase(M.Cells(2, t)) = _ UCase(D.Cells(i, ARR(t - 1)))) Next If Chek = -4 Then _ Obj.Add i, D.Cells(i, "F") i = i + 1: Chek = 0 Loop If Obj.Count Then _ M.Cells(2, "k").Resize(Obj.Count) = _ Application.Transpose(Obj.items) Set Obj = Nothing: Set D = Nothing: Set M = Nothing Erase ARR End Sub الملف من جديد MY_search_MD_SH.xlsm

جرب هذا الملف MY_search.xlsx

هل تريد ان تضيف العدد 8 الى الناتج بعد عملية القسمة والضرب ام تريد اضافة الرقم 8 الى العدد 1460 ثم القيام بعمليتي القسمة والضرب

اقترح عليك هذا الملف (من الأرشيف) هناك مجال لاضافة الصادر والوارد في صفحات مستقلة من خلال الصفحة الرئيسية Sader_Wared1.xlsm

تم التعديل على الملف ليعمل كما تريد لا حاجة لادراج الترقيم (اكسل يفعلها أوتوماتيكياً) يمكنك التحرك داخل الشيت حتى ولو كان اليوزر ظاهراً Sort_Please.xlsm

هناك مسشاركة لي بهذا الموضع على هذا العنوان https://www.officena.net/ib/topic/100396-كتابة-جدول-مرتب-ابجدياً/?tab=comments#comment-607709

استبدل في الكود "F18" بــــ "D20" تعديل الملف Rawateb_New.xlsm

الأخ medobest اعتذر عن شرح الكود وذلك فقط لضيق الوقت ربما يقوم احد الاساتذة بعمل ذلك

الخلايا المدمجة من جديد (تقوم بارباك اي ماكرو و اي معادلة) تم ازالة الخايا المدمجة التي يسري عليها الكود انظر الى الملف واضغط فقط على الزر في صفحة Repport Rawateb.xlsm

تم معالجة الامر Example3.xlsm

لا اعلم السبب لكن عندي يعمل بشكل جيد انظر المرفق Fil_combo.xlsm

أكثر من مرة اكرر لا لزوم لدمج الخلايا حيث توجد معادلات الحل هنا HISHAM_1.xlsx

جرب هذا الملف MY_test (4).xlsx