Ali Mohamed Ali

ممتاز بارك الله فيك ودائما الى الأمام

تفضل اخى الكريم باللغة العربية والإنجليزية كمان تفقيط عربى وانجليزى.xlsm

بعد اذن الأستاذ بكار هذا موقع اخر http://www.mediafire.com/file/rwsccws0d3tmauq/learn+functions+in+excel+2007.rar بارك الله فيكم جميعا

ممكن تجرب هذا تقرير غياب.xlsx

لا تصلح فى هذه الحالة وليست بدقة المعادلة المقدمة لك سابقا

تفضل أخى 2018شيت مدرستى - الصف الرابع-.xls

جرب هذا aaaaa.rar

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

ممكن تتبع وتجربة هذا https://www.officena.net/ib/topic/38355-مكتبة-الموقع-مُجمِع-البيانات-للاكسيل-excel-data-collector/

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

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

وعليكم السلام هذه محاولة بالمعادلات الى ان يتم تدخ الأساتذة بعمل كود لك ولكن لابد من فتح جميع الملفات فى وقت واحد حتى يتم نقل البيانات بكل دقة جميع الملفات بملف واحد باستخدام المعادلات في اكسل.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