ابو اسامة العينبوسي

السلام عليكم اكمل الحل ________________.rar

=IF(F9<>"",MIN(0,F9-B9),"")

السلام عليكم اضفنا حلقه ثانيه بمقدرا حركتين ان الاخ يريد حذف المتكرر في عمود الرقم Application.ScreenUpdating = False For x = 1 To 2 For i = 2 To 11 For ii = 2 To 11 If Sheets("1").Cells(i, 2) = Sheets("2").Cells(ii, 2) Then Sheets("1").Cells(i, 2).EntireRow.Delete Sheets("2").Cells(ii, 2).EntireRow.Delete End If Next ii Next i Next x On Error Resume Next Application.ScreenUpdating = True

السلام عليكم استاذ عادل كود جميل ممكن كودك يكون هكذا ؟ Application.ScreenUpdating = False For i = 2 To 10 Sheets("2").Select For ii = 2 To 11 If Sheets("1").Cells(i, 1) = Sheets("2").Cells(ii, 1) And Sheets("1").Cells(i, 2) = Sheets("2").Cells(ii, 2) Then Sheets("1").Cells(i, 1).EntireRow.Delete Sheets("2").Cells(ii, 1).EntireRow.Delete End If Next Next On Error Resume Next Application.ScreenUpdating = True

السلام عليكم الكود التالى يعمل على الخليه A1 يعمل على 2007 و 2003 من ابو تامر نتعلم دائما Dim oldval As Double Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$1" Then Target = oldval + Target Application.EnableEvents = True Else Application.EnableEvents = True Exit Sub End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = True If Target.Address = "$A$1" Then oldval = Target End Sub

السلام عليكم Sub test() With Application .Calculation = xlCalculationManual .ScreenUpdating = False For i = 2 To Sheets(1).UsedRange.Rows.Count - 1 With Sheets(3) .Cells(i, 1) = Sheets(1).Cells(i, 1) .Cells(i, 2) = Sheets(2).Cells(i, 1) .Cells(i, 3) = Application.WorksheetFunction.Sum(Cells(i, 1), Cells(i, 2)) .Cells(i, 4) = Sheets(1).Cells(i, 2) .Cells(i, 5) = Sheets(2).Cells(i, 2) .Cells(i, 6) = Application.WorksheetFunction.Sum(Cells(i, 4), Cells(i, 5)) .Cells(i, 7) = Sheets(1).Cells(i, 3) .Cells(i, 8) = Sheets(2).Cells(i, 3) .Cells(i, 9) = Application.WorksheetFunction.Sum(Cells(i, 7), Cells(i, 8)) .Cells(i, 10) = Sheets(1).Cells(i, 4) .Cells(i, 11) = Sheets(2).Cells(i, 4) .Cells(i, 12) = Application.WorksheetFunction.Sum(Cells(i, 10), Cells(i, 11)) .Cells(i, 13) = Sheets(1).Cells(i, 5) .Cells(i, 14) = Sheets(2).Cells(i, 5) .Cells(i, 15) = Application.WorksheetFunction.Sum(Cells(i, 13), Cells(i, 14)) .Cells(i, 16) = Application.WorksheetFunction.Sum(Cells(i, 3), Cells(i, 6), Cells(i, 9), Cells(i, 12), Cells(i, 15)) End With Next .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub CVTE7_2.rar

السلام عليكم =COUNTIF(B9:AG9,"<>"&"")

السلام عليكم ارسل الملف الذى تعمل عليه هل هناك شرط لاخفاء ؟ Rows(3).EntireRow.Hidden = True Rows(15).EntireRow.Hidden = True Rows(30).EntireRow.Hidden = True

السلام عليكم =IF(SUM(A2:E2)=SUM(G2:K2),SUM(A2:E2),"خطأ")

السلام عليكم هنا ملف صغير لكيفية عمل دالة offset اعمل دبل كلك على اى رقم من الارقام من 1-8 لاعادة ترتيب الارقام My_First_Puzzle.rar

السلام عليكم Private Sub UserForm_Initialize() With Me .Width = Application.Width .Height = Application.Height End With End Sub ---------------------------------------------- Private Sub UserForm_Layout() With Me .Left = Application.Left .Top = Application.Top End With End Sub --------------------------------------------------------------------- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True End If End Sub

السلام عليكم ممكن ان تسمى مجموعة خلايا باسم معين ليشير اليها هنا Nizar هو اسم لمدى(نطاق) موجود موجود في الورقة الاولى النطاق من A2:A6 ممكن تسمى المدى اي اسم تريد

السلام عليكم في حال تم اختيار الحفظ بتنسيق xls لن تظهر الرساله لكن الملف قد يفقد بعض مزايا 2007 اما اذا اردت الحفظ بتنسيق xlsx ستظهر الرساله دائما (حسب موقع ميكروسوفت )

السلام عليكم Private Sub UserForm_Initialize() With UserForm1 .Width = ActiveWindow.Width .Height = ActiveWindow.Height End With End Sub

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

السلام عليكم جهد تشكر عليه و افكار جديده

السلام عليكم ممكن تعدل علعى هذا كما تريد MYsheet = Cells(1, 2).Text X = Sheets(MYsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1 With Sheets(MYsheet) .Cells(X, 1) = Cells(1, 2) .Cells(X, 2) = Cells(2, 2) .Cells(X, 3) = Cells(3, 2) .Cells(X, 4) = Cells(4, 2) .Cells(X, 5) = Cells(5, 2) .Cells(X, 6) = Cells(6, 2) .Cells(X, 7) = Cells(7, 2) End With

السلام عليكم هذا مثال ان كان المطلوب نكمل غير الاسم في |B1 main الى الاسم الذى تريد الترحيل اليه MYsheet = Cells(1, 2).Text X = Sheets(MYsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1 With Sheets(MYsheet) For Y = 1 To 7 .Cells(X, Y) = Cells(Y, 2) Next Y End With يتم الترحيل الى الاسم المحدد Test_it.rar

السلام عليكم ** لمن يجيدون الانجليزية** * هل تريد ان ترى اكواد لم ترها من قبل * هل تريد ان ترى حلول ابداعية * هل تريد ان ترى اوامر و تراكيب مدهشة اليكم العلم من منهله(اضافة الى موقعنا الحبيبOfficena ) http://tech.groups.yahoo.com/group/ExcelVBA/ **من يملك حساب ياهو يمكنه الدخول من خلاله

السلام عليكم اود شكرك على تصميمك وتنسيقك الجميل

السلام عليكم هناك طرق اخرى موجوده في المنتدى Private Sub ComboBox1_Click() Sheets(Me.ComboBox1.Text).Select End Sub -------------------------------------------- Private Sub UserForm_Initialize() For i = 1 To ThisWorkbook.Worksheets.Count With Me.ComboBox1 .AddItem Sheets(i).Name End With Next Me.ComboBox1 = Sheets(1).Name End Sub mainpage2.rar

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

السلام عليكم اخى السائل khhanna انت سالت عن حمايه الخلايا التى تحتوى على صيغ لكن الكود بحمايه كل الشيت سارفق ملف جربه عساه يكون اقرب لما تريد حيث لا يسمح لك بالتحرير(الكتابه)في الخليه المحتوية على صيغة Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.HasFormula Then ActiveSheet.Protect Else ActiveSheet.Unprotect End If End Sub Protect_Formulas.rar

السلام عليكم اخى ابو خالد لكل كل الشكر و التقدير اخوك عمر(ابو اسامة)

السلام عليكم شكرا لكل الاساتذه و الاخوه هذا شعار اوفسينا التطور و التقدم دائما بخصوص طلب الاخ مسح البيانات السابقه استخدم الكود التالى بدى الاول Sub test() Dim Mrng As Range Dim cell As Range Dim Mysum As Long Set Mrng = Sheets(1).Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)) Sheets(2).Select Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 6)).ClearContents Sheets(1).Select For Each cell In Mrng x = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1 If cell.Value = Chr(252) Then Sheets(2).Cells(x, 1) = Cells(cell.Row, 2) Sheets(2).Cells(x, 2) = Cells(cell.Row, 3) Sheets(2).Cells(x, 3) = Cells(cell.Row, 4) Sheets(2).Cells(x, 4) = Cells(cell.Row, 5) Sheets(2).Cells(x, 5) = Cells(cell.Row, 6) Sheets(2).Cells(x, 6) = Cells(cell.Row, 7) Sheets(2).Cells(x, 7) = Cells(cell.Row, 8) End If Next cell Mysum = Application.WorksheetFunction.SumIf(Mrng, Chr(252), Range(Cells(2, 4), Cells(Cells(Rows.Count, 4).End(xlUp).Row, 4))) MsgBox "مجموع الفواتير المرحلة هو " & Mysum, vbMsgBoxRight, "تم الترحيل " End Sub