Ali Mohamed Ali

جزاك الله كل الخير وبارك الله فيك وجعله فى ميزان حسناتك عمل رائع وممتاز -أحسنت أدخلك الله جنات الفردوس الأعلى وغفر لك ونور قبرك بالإيمان

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

تفضل أخى الكريم TES T2.xlsx

بارك الله فيك أستاذنا زيزو كود ممتاز جعله الله فى ميزان حسناتك ولا اثراء الموضوع اليك كود أخر كشف حساب عميل حسب المخزن - Copy.xlsm

وعليكم السلام لو من الأفضل ارسال الملف نفسه للعمل عليه

هذا الكود الستاذ ياسر خليل يفى بالغرض Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B3:U1026").ClearContents lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 2 ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy sh.Range("B" & lr).PasteSpecial xlPasteValues On Error Resume Next sh.Columns(5).Replace 0, "" sh.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = False End Sub

تفضلى المعادلة =IF(B2="","",IF(AND(B2>=50,B2<=59),B2*200,IF(B2="","",IF(AND(B2>=100,B2<=109),B2*220,IF(B2="","",IF(AND(B2>=30,B2<=39),B2*140,""))))))

أحسنت أستاذى بكار بارك الله فيك

بارك الله فيك وجعله فى ميزان حسناتك

تفضل أخى الكريم ترحيل بيانات.rar

تفضل أخى الكريم تمت الإجابة من قبل الأستاذ ياسر خليل Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B7:U406").ClearContents lr = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy sh.Range("B" & lr).PasteSpecial xlPasteValues On Error Resume Next sh.Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = False End Sub

معادلة رائعة بارك الله فيك أستاذى -أحسنت

تفضل أخى الكريم حذف وإضافة صف فارغ.xlsm

تفضل التوضيح بالصور وذلك يتم من خلال قائمة التحقق من صحة البيانات Data Validation

بأن تضع هذا الكود فى حدث الورقة المراد العمل عليها Private Sub Worksheet_SelectionChange(ByVal Target As Range) For Each cel In [A1:A1000] If Application.WorksheetFunction.CountIf(Range("A1:A1000"), cel) > 1 Then بمعنى العمل على العمةد الأول وهو العمود A الذى به البيانات cel.Interior.ColorIndex = 4 4 هو رقم لون التظليل Else cel.Interior.ColorIndex = 0 End If Next End Sub

جرب هذا أخى الكريم فاتورة ضريبية تجريبية.xlsm

لأنها أول خلية مكتوب فيها المعادلة من العمود الثانى وهو B وبالتالى فقمت بتثبيت هذه الخلية B1 ولم أسحب المعادلة يسارا مباشرة لأنى أصبحت أعدل فى كل خلية من خلايا الصف بحيث لا يتغير هذا الجزء من المعادلة مع تغيير الأعمدة ($B$1:B1) فإذا مثلا سحبت المعادلة أفقيا مباشرة فسوف يتغير هذا الجزء بتغير العمود المسحوب فيه المعادلة بمعنى لو سحبت الى العمود D فيصبح هذا الجزء كالتالى ($B$1:D1) ولكنى أريده يتغير بتغير B فقط أى تكون الخلية الأولى ($B$1:B1) والخلية الثانية ($B$1:B2) وهكذا الى اليوم ....31 بارك الله فيكم اتمنى ان تكون وضحت

تفضل أخى محمود فلتر.xlsm

تفضل أخى المعادلة أفقيا جدول الشهر مع 2التعديل.xlsx

على فكرة ملف الأستاذ محمد شغال تمام واليك الملف وايضا بع معادلة الأستاذ سليم جدول الشهر مع التعديل.xlsx

تفضل أخى محمود الغاء الفلترة.xlsm

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

أو ضع هذا الكود فى موديول ليعمل الوقت فى الخلية C13 كما تريد Sub Date_Time() On Error Resume Next 1 DoEvents N = Now Range("c13") = Format(N, "[$-F400]h:mm:ss AM/PM") T = T + 1 For r = 1 To 10000000: Next r GoTo 1 End Sub

قم بتغيير هذا السطر من الكود Range("t" & lin) = Names(j) الى Range("w" & lin) = Names(j) ولكم جزيل الشكر

طبعا أفضل لانه لا يمكنك كتابة معادلة فى نفس الخلية التى تقوم بالإدخال فيها