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

السلام عليكم ورحمة الله اضف هذا الجزء الى الكود Range("B2").ClearContents

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

السلام عليكم ورحمة الله ضع هذا الكود فى موديول وخصص له زر ملحوظة : لا تضغط على الزر مرتين الابعد تغيير القيمة فى " B2" Sub Add_Amount() Range("D2") = Range("D2") + Range("B2") End Sub

السلام عليكم ورحمة الله اكتب المعادلة الاولى فى عمود اليوم والمعادلة الثانية فى عمود الشهر والمعادلة الثالثة فى عمود السنة =DATEDIF(DATE($G4;$F4;$E4);"1/10/2016";"md") =DATEDIF(DATE($G4;$F4;$E4);"1/10/2016";"ym") =DATEDIF(DATE($G4;$F4;$E4);"1/10/2016";"y")

السلام عليكم ورحمة الله اكتب هذا الكود فى موديول وخصص له زر Sub Statement_Acc() m = 6 For R = 2 To 30 If Cells(R, 1) >= Range("N2") And Cells(R, 1) <= Range("N2") And Cells(R, 2) = Range("N1") Then m = m + 1 Range("J" & m) = Cells(R, 1) Range("K" & m) = Cells(R, 3) Range("L" & m) = Cells(R, 4) Range("M" & m) = Cells(R, 5) Range("N" & m) = Cells(R, 6) End If Next End Sub

السلام عليكم ورحمة الله كود لترقيم 5 اعمدة متتالية من 1 الى 500 كل عمود مائة رقم Sub Serials() For R = 1 To 100 For S = 6 To 10 Cells(R, S) = R + ((S - 6) * 100) Next Next End Sub

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

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

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

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

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

كل عام وجميع الامة العربية والاسلامية بألف خير

الف مبروك فأنت جدير بها وهى جديرة بك ! نرجو من الله دوام التوفيق

السلام عليكم ورحمة الله الصق هذا الكود فى موديول جديد وخصص له زر Sub Tarhil() For R = 2 To 200 If Cells(R, 2) = Sheet3.Cells(R, 6) Then Cells(R, 9) = Sheet3.Cells(R, 2) Cells(R, 10) = Sheet3.Cells(R, 4) Cells(R, 11) = Sheet3.Cells(R, 5) Cells(R, 12) = Sheet3.Cells(R, 8) End If Next End Sub

السلام عليكم ورحمة الله انشئ ورقة عمل جديدة واكتب هذا الكود فى موديول وانشئ له زر وضع رقم الفاتورة التى تريد البحث عنها فى الخلية "C3 " Sub Search_Inv() Dim sh As Worksheet Dim R As Integer For Each sh In Worksheets For R = 6 To 1000 If sh.Name <> "Search" Then If sh.Cells(R, 4) = Range("C3").Value Then sh.Range("B" & R & ":L" & R).Copy Range("B6").PasteSpecial xlPasteValues Range("B6").PasteSpecial xlPasteFormats End If End If Next R Next sh Application.CutCopyMode = False End Sub

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

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

السلام عليكم ورحمة الله ضع هذا الكود فى مديول Function Daraga(Cel As Range) As Variant If Cel.Value < 50 Or Cel.Value = "" Then Daraga = "" ElseIf Cel.Value > 60 Then Daraga = Cel.Value - 10 Else Daraga = 50 End If End Function

السلام عليكم ورحمة الله اكتب هذه المعادلة =IF(VLOOKUP(G10;B4:I8;5;0)=0/1/1900;"";VLOOKUP(G10;B4:I8;5;0))

السلام عليكم ورحمة الله لجمع الاعداد السالبة =SUMIF($L$4:$L$10;"<0") لجمع الاعداد الموجبة =SUMIF($L$4:$L$10;">0")

السلام عليكم ورحمة الله الصق هذا الكود فى موديول وخصص له زر Sub Tarhil_Boys() Range("C11:U46").ClearContents Range("C55:U89").ClearContents LR = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row For R = 9 To LR If Sheet1.Cells(R, 4) = "ذكر" Then B = Application.WorksheetFunction.CountIf(Sheet1.Range("F9:F" & R), Cells(2, "M")) If Cells(2, "M") = Sheet1.Cells(R, 6) Then B = B + 11 Range("C" & B) = Sheet1.Cells(R, 3) Range("D" & B) = Sheet1.Cells(R, 27) Range("E" & B) = Sheet1.Cells(R, 9) Range("F" & B) = Sheet1.Cells(R, 10) Range("G" & B) = Sheet1.Cells(R, 11) Range("H" & B) = Sheet1.Cells(R, 12) Range("I" & B) = Sheet1.Cells(R, 19) Range("J" & B) = Sheet1.Cells(R, 5) Range("K" & B) = Sheet1.Cells(R, 2) Range("Q" & B) = Sheet1.Cells(R, 14) Range("T" & B) = Sheet1.Cells(R, 18) End If End If Next Call Tarhil_Girls End Sub Sub Tarhil_Girls() x = Cells(Rows.Count, 3).End(xlUp).Row - 1 LR = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row For R = 9 To LR If Sheet1.Cells(R, 4) = "أنثى" Then B = Application.WorksheetFunction.CountIf(Sheet1.Range("F9:F" & R), Cells(2, "M")) If Cells(2, "M") = Sheet1.Cells(R, 6) Then B = B + 64 - x Range("C" & B) = Sheet1.Cells(R, 3) Range("D" & B) = Sheet1.Cells(R, 27) Range("E" & B) = Sheet1.Cells(R, 9) Range("F" & B) = Sheet1.Cells(R, 10) Range("G" & B) = Sheet1.Cells(R, 11) Range("H" & B) = Sheet1.Cells(R, 12) Range("I" & B) = Sheet1.Cells(R, 19) Range("J" & B) = Sheet1.Cells(R, 5) Range("K" & B) = Sheet1.Cells(R, 2) Range("Q" & B) = Sheet1.Cells(R, 14) Range("T" & B) = Sheet1.Cells(R, 18) End If End If Next End Sub

الف مبروك للمنتدى واعضاء المنتدى اختيار موفق جدا الف مبروك استاذنا الكبير سليم

السلام عليكم ورحمة الله تفضل هذا الكود Sub Summing1() f = 0 s = 0 For i = 2 To Sheets.Count For R = 15 To Cells(Rows.Count, "I").End(xlUp).Row Sheets(i).Name = i - 1 f = f + Sheets(i).Cells(R - 11, "I") Cells(R, "J") = f s = s + Sheets(i).Cells(R - 11, "J") Cells(R, "K") = s Next Next End Sub

السلام عليكم ورحمة الله اكتب هذا الكود فى موديول واربطه بذر واضغط عليه كلما اردت ذلك Sub Empty_Row() For R = 5 To Cells(Rows.Count, 3).End(xlUp).Row If Range("C" & R).Value = "" Then Range("C" & R & ":F" & R).Value = Range("C" & R + 1 & ":F" & R + 1).Value Range("C" & R + 1 & ":F" & R + 1).ClearContents End If Next End Sub

السلام عليكم ورحمة الله وبركاته اكتب N=N+2 بدلا من N=N+1 ثم اضف Range("A" & N) = (N - 11) / 2 قبل عبارة End With