نجوم المشاركات

وعليكم السلام-فقط عليك استخدام هذه المعادلة =IFERROR(VLOOKUP($L11,الجدول1,6,0),"") الفلزات1.xlsx

تم معالجة الأمر Option Explicit Sub Fill_data() Dim i%, t% Dim Rg As Range t = 2 With Sheets("data") Set Rg = .Range("A1").CurrentRegion If Rg.Rows.Count > 1 Then _ Rg.Offset(1).Resize(Rg.Rows.Count - 1).Clear For i = 2 To Sheets.Count If Sheets(i).Name <> "data" Then .Cells(t, 1) = Sheets(i).Name .Cells(t, 2).Resize(, 5).Value = _ Sheets(i).Cells(4, 5).Resize(, 5).Value t = t + 1 End If Next i With .Cells(t, 1) .Value = "Sum" .Offset(, 1).Resize(, 5).Formula = _ "=SUM(B2:B" & t - 1 & ")" .Resize(, 6) _ .Interior.ColorIndex = 6 End With Set Rg = .Range("A1").CurrentRegion If Rg.Rows.Count > 1 Then Set Rg = Rg.Offset(1).Resize(Rg.Rows.Count - 1) With Rg .Borders.LineStyle = 1 .InsertIndent 1 .NumberFormat = "#,##.00" With .Font .Bold = 1: .Size = 14: End With .Value = .Value End With End If End With End Sub الملف مرفق Abo_Hasn.xlsm

السلام عليكم ورحمة الله استخدم هذا الكود Sub AnalysesData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long, j As Long, p As Long Dim Arr, Data As String Set ws = Sheets("ورقة1") Set Sh = Sheets("ورقة2") Sh.Range("B5").Resize(100, 6).ClearContents LR = ws.Range("D" & Rows.Count).End(xlUp).Row Data = Sh.Range("B2") Arr = ws.Range("B3:G" & LR).Value ReDim Preserve Arr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 4) = Data Then p = p + 1 For j = 1 To UBound(Arr, 2) Arr(p, j) = Arr(i, j) Next End If Next If p > 0 Then Sh.Range("B5").Resize(p, UBound(Arr, 2)).Value = Arr End Sub

جرب هذا الملف للانتقال من تكست بوكس الى اخر استعمل Tab او Enter Amine.xlsm

شكرا استاذ Ali Mohamed Ali وهو المطلوب جزاك الله عني كل خير

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

تعبنا كثيراُ من هذا الأمر ونبهنا أكثر على عدم قبول اى مشاركة بدون رفع ملف توضيحى للمطلوب ... حيث لا يمكن العمل على التخمين , كما ان رفع المشاركة بدون ملف تعتبر لا قيمة او جدوى لها لكل من يطلع عليها بل بالعكس يؤدى الى اهدار وقتهم جميعا فلا تنتظر المساعدة من احد حتى يتم الإلتزام من الجميع برفع ملف عند الرغبة فى رفع اى مشاركة جديدة

حياك الله اخي @خالد عبد الغفار بالتوفيق ......

مشاركة مع اساتذتي هو كود استاذي العزيز محمد أبوعبدالله مع بعض التعديل Dim I As Integer Dim x As Date mySqL = "Select * From tt" Debug.Print mySqL Set rst = CurrentDb.OpenRecordset(mySqL) For I = 1 To Me.t3 rst.AddNew rst!dat = DateAdd("m", [t2] * I, Date) rst.Update rst.MoveNext Next Me.Requery End Sub

مشاركة مع استاذي محمد tb.accdb

اخي الكريم يوجد لديك حقب t2 فهنت ان وظيفته تباعد الاشهر حسب ما ما هو مكتوب واليك الكود بدون تباعد الاشهر Dim I As Integer Dim x As Date mySqL = "Select * From tt" Debug.Print mySqL Set rst = CurrentDb.OpenRecordset(mySqL) For I = 1 To Me.t3 rst.AddNew rst!dat = DateAdd("m", [t2], Date) rst.Update Next Me.Requery End Sub تحياتي

شوف هذا بيع مواد-11.accdb

تفضل اخي الكريم Database1011.rar تحياتي

وعليكم السلام-تفضل تم عمل كل المطلوب فى الصفحة الأولىSURGICAL_ALL (10) ROTA SURGICAL JULY TRILE 2.xlsm

هل يمكن جعل الكود ياسم الشيت بدل الرقم ما هو اسم كل صفحة من 1 الى عدد الشيتات هل هو " Sheet1 " او " Data1" او "1 Any thing " " Sheet2 " او "Data2 " او "1 Any thing " الح.....

السلام عليكم sabry fahmy اتفضل برنامج لاحد الافاضل في المنتدي شوف هل يفي بالغرض ام تريد بعض التعديلات وانا معاك ان شاء الله Database4.rar