حسونة حسين

تفضل اخى الكود كاملا Private Sub CommandButton3_Click() Dim C As Range, SH As Worksheet, WS As Worksheet, A As String Set SH = ThisWorkbook.Worksheets("Sheet1") If SH.Range("I4").Value <> "" Then Set WS = ThisWorkbook.Worksheets("Sheet2") A = SH.Range("I4").Value Else Set WS = ThisWorkbook.Worksheets("Sheet4") A = WS.Range("L2").Value End If Set C = WS.Range("C:C").Find(What:=A, LookIn:=xlValues, LookAt:=xlWhole) With SH .Range("d6") = WS.Cells(C.Row, "b") .Range("d8") = WS.Cells(C.Row, "d") .Range("d10") = WS.Cells(C.Row, "e") .Range("d12") = WS.Cells(C.Row, "f") .Range("d14") = WS.Cells(C.Row, "g") .Range("d16") = WS.Cells(C.Row, "h") .Range("d18") = WS.Cells(C.Row, "i") .Range("g6") = WS.Cells(C.Row, "c") .Range("g8") = WS.Cells(C.Row, "j") .Range("g10") = WS.Cells(C.Row, "k") .Range("g12") = WS.Cells(C.Row, "l") .Range("g14") = WS.Cells(C.Row, "m") .Range("g16") = WS.Cells(C.Row, "n") .Range("g18") = WS.Cells(C.Row, "o") End With End Sub

تم التعديل من L4 الى L2 عذرا لانى اعمل عن طريق الموبايل

تم تعديل الكود

تفضل اخى الكريم ضع هذا الكود في ملف ( الميكرو المستخدم في التعديل علي الملفات.xlsx) فى موديل عادى ثم شغل الكود Option Explicit Sub Delete_Row_If_Equal_A_Specific_Value() Dim WB As Workbook, WS As Worksheet, SH As Worksheet, sPath As String, sFile As String Dim C As Range, M As Long, R As Long Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.EnableEvents = False Set SH = ThisWorkbook.Worksheets("Sheet1") sPath = ThisWorkbook.Path & "\الملفات\" sFile = Dir(sPath & "*.xls*") Do While sFile <> "" Set WB = Workbooks.Open(sPath & sFile, False) For Each WS In WB.Worksheets M = WS.Range("A" & Rows.Count).End(xlUp).Row For R = 2 To M Set C = WS.Range("A:A").Find(What:=SH.Range("A" & R).Value, LookAt:=xlWhole) If C Is Nothing Then GoTo 1 WS.Rows(C.Row).Delete 1 Next R Next WS WB.Close SaveChanges:=True sFile = Dir Loop Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.EnableEvents = True End Sub

وعليكم السلام ورحمة الله وبركاته تفضل اخى Private Sub CommandButton3_Click() Dim C As Range, SH As Worksheet, WS As Worksheet Set SH = ThisWorkbook.Worksheets("Sheet1") If SH.Range("I4").Value <> "" then Set WS = ThisWorkbook.Worksheets("Sheet2") a=SH.Range("I4").value else set WS = ThisWorkbook.Worksheets("Sheet4") a=ws.range("L2").value end if Set C = WS.Range("C:C").Find(What:=A, LookAt:=xlWhole) With SH .Range("d6") = WS.Cells(C.Row, "b") .Range("d8") = WS.Cells(C.Row, "d") .Range("d10") = WS.Cells(C.Row, "e") .Range("d12") = WS.Cells(C.Row, "f") .Range("d14") = WS.Cells(C.Row, "g") .Range("d16") = WS.Cells(C.Row, "h") .Range("d18") = WS.Cells(C.Row, "i") .Range("g6") = WS.Cells(C.Row, "c") .Range("g8") = WS.Cells(C.Row, "j") .Range("g10") = WS.Cells(C.Row, "k") .Range("g12") = WS.Cells(C.Row, "l") .Range("g14") = WS.Cells(C.Row, "m") .Range("g16") = WS.Cells(C.Row, "n") .Range("g18") = WS.Cells(C.Row, "o") End With End Sub تم التعديل

وعليكم السلام ورحمة الله وبركاته محتاج تمسح الارقام فقط ام السطر كاملا الذي به الرقم

وعليكم السلام ورحمة الله وبركاته امسح هذه السطور اخى الكريم Application.PrintCommunication = False With Sheets("Sheet3").PageSetup .FitToPagesWide = 1 .FitToPagesWide = False End With Application.PrintCommunication = True

جرب هذا التعديل اخى الكريم Option Explicit Sub MyStuNames() Dim Rng1 As Worksheet, Rng2 As Worksheet, T As String, Y As Integer, X As Double, Cel As Range, i As Integer Application.ScreenUpdating = False Set Rng1 = Worksheets("StudNames"): Set Rng2 = Worksheets("Analysis") T = Rng2.[AB1] X = Application.CountIf(Rng1.Range("B:B"), T) Y = IIf(Range("LangCod") = 2, 5, 4) Rng2.Range("B8:C42") = Empty i = 1 For Each Cel In Rng1.Range("B2:B" & Rng1.Cells(Rows.Count, 2).End(xlUp).Row) If Cel = T Then Rng2.Cells(7 + i, "B").Value = i Rng2.Cells(7 + i, "C").Value = Rng1.Cells(Cel.Row, Y).Value i = i + 1 End If Next Application.ScreenUpdating = True End Sub

تفضل اخى الكريم sief.xls

وعليكم السلام ورحمة الله وبركاته وجزاكم مثله اخى عطيه والحمد لله الذي بنعمته تتم الصالحات

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

السلام عليكم ورحمة الله وبركاته وبها نبدأ عدل هذا السطر iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row الى iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row +1

تفضل اخى الكريم عطيه يتم العد في العامود z وضع دوائر حمراء على الحصص ووضع عددها في العامود z.xls

And cel.Offset(0, -1) = i دى الخاصه بالعامود a يمكنك حذفها

وهذا ما بحدث عند تشغيل كودك مش فاهم دى بصراحه

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

السلام عليكم ورحمة الله وبركاته وبها نبدأ ارفق ملف لنرى المشكله او اضعط على علامه التعجب اورفق صورة للذي يظهر

الحمد لله الذي بنعمته تتم الصالحات وفيك بارك اخى عبدالله

جزاكم الله خيرا على دعاؤك الطيب الحمد لله الذي بنعمته تتم الصالحات

هذا الكود يوضع في ال userform

وعليكم السلام ورحمه الله وبركاته حضرتك عند 3 ملفات 1- ATS (1).xls 2- ghبرنامج الراتب.XLS 3- شهادات-العمل-والأجر-المحين.xlsm ATS recto دي صفحة موجوده في ملف اسمه شهادات-العمل-والأجر-المحين.xlsm حضرتك عايز تنقلها فين بالظبط ؟ ولا عايز تنقل منها بيانات ؟ اين مكان العامود ATTESTATION ؟

السلام عليكم ورحمه الله وبركاته وبها نبدأ Option Explicit 'http://www.mrexcel.com/archive/VBA/24009.html Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long Private Const GWL_STYLE As Long = (-16) 'Sets a new window style Private Const WS_SYSMENU As Long = &H80000 'Windows style Private Const WS_MINIMIZEBOX As Long = &H20000 Private Const WS_MAXIMIZEBOX As Long = &H10000 Private Const SW_SHOWMAXIMIZED = 3 Private Sub UserForm_Activate() Dim lFormHandle As Long, lStyle As Long '=========================================== '= Originally from Dax = '= Modified with comments by Ivan F Moala = '= 22/07/01 = '=========================================== 'Lets find the UserForm Handle the function below retrieves the handle 'to the top-level window whose class name ("ThunderDFrame" for Excel) 'and window name (me.caption or UserformName caption) match the specified strings. lFormHandle = FindWindow("ThunderDFrame", Me.Caption) 'The GetWindowLong function retrieves information about the specified window. 'The function also retrieves the 32-bit (long) value at the specified offset 'into the extra window memory of a window. lStyle = GetWindowLong(lFormHandle, GWL_STYLE) 'lStyle is the New window style so lets set it up with the following lStyle = lStyle Or WS_SYSMENU 'SystemMenu lStyle = lStyle Or WS_MINIMIZEBOX 'With MinimizeBox lStyle = lStyle Or WS_MAXIMIZEBOX 'and MaximizeBox 'Now lets set up our New window the SetWindowLong function changes 'the attributes of the specified window , given as lFormHandle, 'GWL_STYLE = New windows style, and our Newly defined style = lStyle SetWindowLong lFormHandle, GWL_STYLE, (lStyle) 'Remove >'< if you want to show form Maximised 'ShowWindow lFormHandle, SW_SHOWMAXIMIZED 'Shows Form Maximized 'The DrawMenuBar function redraws the menu bar of the specified window. 'We need this as we have changed the menu bar after Windows has created it. 'All we need is the Handle. DrawMenuBar lFormHandle End Sub

السلام عليكم ورحمه الله وبركاته وبها نبدأ هذه المعادله لتجلب لك المؤسسه =INDEX($B$4:$D$4;MATCH(F5;B5:D5;0)) وهذه المعادله في ملفك تجلب اقل سعر =MIN(B5:D5)

وعليكم السلام ورحمه الله وبركاته استخدم هذه المعادله وستفي بالمطلوب ان شاء الله =COUNTIF(D3:D22,"<>"&$D$1)

اخى الكريم انت لم تضع الكود في ملفك