ابراهيم الحداد

السلام عليكم ورحمة الله تفضل اخى الكريم تجميع بيانات.rar

السلام عليكم ورحمة الله تفضلى New folder (2).rar

السلام عليكم ورحمة الله ضع هذا الكود فى حدث الصفحة وسيعمل تلقائيا دون تدخل منك Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub Dim cel As Range For Each cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) cel.Offset(0, 1).Value = cel Next End Sub

السلام عليكم ورحمة الله تفضلى New folder (2).rar

السلام عليكم ورحمة الله اكتب الكود التالى واربطه بالزر الموجود بالملف Sub Sorting() Range("A2:S" & Range("D" & Rows.Count).End(xlUp).Row).Sort key1:=Range("K2"), order1:=xlAscending End Sub

السلام عليكم ورحمة الله استبدل الكود السابق بما يلى Sub كتشنة() Range("A5:m300").Sort Key1:=Range("d5"), Order1:=xlAscending End Sub

السلام عليكم ورحمة الله نعم اخى الكريم تفسيرك سليم وفى محله اذا ازلت هذه العبارة (On Error Resume Next) لن يعمل الكود معك

السلام عليكم ورحمة الله تفضل اخى الكريم ترتيب وتصاعدى.rar

السلام عليكم ورحمة الله تفضل اخى الكريم appo.rar

السلام عليكم ورحمة الله اذا حدث معك هذا الامر مرة اخرى حدد الخلية (K6) ثم اضغط على (CTRL+SHIFT+ENTER) واسحب نزولا -- اليك الملف عمولة.rar

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

السلام عليكم ورحمة الله تفضل تجميع الكميات الواردة والمنصرفه على اساس كود الصنف+1111.rar

السلام عليكم ورحمة الله تفضل WEB.rar

السلام عليكم ورحمة الله تفضل اخى الكريم فرق بين تاريخين.rar

السلام عليكم ورحمة الله انسخ الكود التالى والصقه فى موديول وخصص له زر Sub TransrerData() Dim ws As Worksheet, sh As Worksheet Dim LR As Long, LS As Long Dim R As Integer, S As Integer, p As Integer, Cod As Byte, Cod2 As Byte Dim Qty As Long, Qty2 As Long Set ws = Sheets("ÇÑÔíÝ") Set sh = Sheets("ÈíÇä ÊÌãíÚì") sh.Range("B10:K100").ClearContents Application.ScreenUpdating = False LR = ws.Range("E" & Rows.Count).End(xlUp).Row For R = 10 To LR Cod = WorksheetFunction.CountIf(Range(ws.Cells(10, "E"), _ ws.Cells(R, "E")), ws.Cells(R, "E")) If Cod = 1 Then sh.Cells(R, "B") = ws.Cells(R, "E") sh.Cells(R, "C") = ws.Cells(R, "F") sh.Cells(R, "D") = ws.Cells(R, "G") sh.Cells(R, "F") = ws.Cells(R, "I") Qty = WorksheetFunction.SumIf(Range(ws.Cells(10, "E"), ws.Cells(LR, "E")), _ sh.Cells(R, "B"), Range(ws.Cells(10, "H"), ws.Cells(LR, "H"))) sh.Cells(R, "E") = Qty End If Next LS = ws.Range("M" & Rows.Count).End(xlUp).Row p = 9 For S = 10 To LS Cod2 = WorksheetFunction.CountIf(Range(ws.Cells(10, "M"), _ ws.Cells(S, "M")), ws.Cells(S, "M")) If Cod2 = 1 Then p = p + 1 sh.Cells(p, "G") = ws.Cells(S, "M") sh.Cells(p, "H") = ws.Cells(S, "N") sh.Cells(p, "I") = ws.Cells(S, "O") sh.Cells(p, "K") = ws.Cells(S, "Q") Qty2 = WorksheetFunction.SumIf(Range(ws.Cells(10, "M"), ws.Cells(LS, "M")), _ sh.Cells(p, "G"), Range(ws.Cells(10, "P"), ws.Cells(LS, "P"))) sh.Cells(p, "J") = Qty2 End If Next Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله استخدم هذا الكود Sub TTarhil() Dim ws As Worksheet, sh As Worksheet Dim LR As Long, LQ As Long Set ws = Sheets("TD") Set sh = Sheets("DB1") LR = ws.Range("H" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False ws.Range("C11:H" & LR).Copy With sh LQ = .Range("I" & Rows.Count).End(xlUp).Row + 1 .Range("D" & LQ).PasteSpecial xlPasteValues .Range("B" & LQ) = ws.Range("G3") .Range("A" & LQ) = ws.Range("E3") .Range("C" & LQ) = ws.Range("E25") End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله تفضل جدول اعمدة عادل.rar

السلام عليكم ورحمة الله الخطأ منى انا تفضل اخى 2017 بالاسماءكشف تفريغ الايتام.rar

السلام عليكم ورحمة الله انسخ هذا الكود والصقه فى موديول جديد مخصص له زر Sub Sorting_Data() LR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row Sheet2.Range("B9:M" & LR).Sort Key1:=Range("B9"), order1:=xlAscending End Sub

السلام عليكم ورحمة الله تفضل اخى الكريم المصروف + الموقف = العدد المتبقي.rar

السلام عليكم ورحمة الله استاذ خالد الرشيدى مجرد مرورك هو شرف

السلام عليكم ورحمة الله تفضل EAA_1_2017.rar

السلام عليكم ورحمة الله استاذ سليم . الملف سليم اليك المف كشف12.rar

السلام عليكم ورحمة الله ضع هذا الكود فى ورقة 2 وخصص له زر Sub Tra_Data() arr = Sheet2.Range("2:175").Columns i = ActiveSheet.TextBox1 For j = LBound(arr) To UBound(arr) If Sheet2.Cells(1, j).Value = Val(i) Then Lr = Sheet2.Cells(Rows.Count, Sheet2.Cells(1, j).Column).End(xlUp).Row + 1 x = WorksheetFunction.Max(Range("L4:L" & Range("L" & Rows.Count).End(xlUp).Row)) For R = 4 To Range("L" & Rows.Count).End(xlUp).Row If Cells(R, "L") = x Then xx = Cells(R, "L").Offset(0, -1).Value Sheet2.Cells(Lr, j).Value = xx End If Next End If Next End Sub

السلام عليكم ورحمة الله تفضل Salary Data.rar