فوزى فوزى قام بنشر مارس 13, 2023 مشاركة قام بنشر مارس 13, 2023 السلام عليكم ورحمة الله وبركاته في البداية اود اشكر الأستاذ محى الدين والأستاذ حسونة على ما قدموه لى من حل ولكن قمت بتعديل على الشيت بدل ادخال البيانات من خلال الفورم قمت بإدخال البيانات من خلال الشيت مباشرة وعند الضغط على الزر يحصل خطا في الترحيل اصلاح خطأ فى كود الترحيل.xlsm رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مارس 13, 2023 مشاركة قام بنشر مارس 13, 2023 (معدل) In First worksheet in cell AH4 change the month to March then try the following code Sub Test() Dim x, ws As Worksheet, lr As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) With ws lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1 x = Application.Match(.Range("D2").Value2, .Rows(6), 0) If Not IsError(x) Then .Cells(lr, 1).Value = .Cells(lr, 1).Row - 6 .Cells(lr, 2).Value = .Range("B2").Value .Cells(lr, x).Resize(, .Range("F2").Value).Value = .Range("C2").Value End If End With Application.ScreenUpdating = True End Sub تم تعديل مارس 13, 2023 بواسطه lionheart 2 رابط هذا التعليق شارك More sharing options...
فوزى فوزى قام بنشر مارس 13, 2023 الكاتب مشاركة قام بنشر مارس 13, 2023 شكرا على تعبك استاذنا الفاضل ولكن الكود لايعمل ، اما الكود الاول الموجود فى الشيت هو به خطأ اود اصلاحة فقط لانه كان يعطى النتائج مضبوطه فى الاول رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مارس 13, 2023 مشاركة قام بنشر مارس 13, 2023 Does the code raises any errors? The code is working well on my side. Just select the suitable month as the date in cell D2 is in March and the selected month is February 1 رابط هذا التعليق شارك More sharing options...
فوزى فوزى قام بنشر مارس 13, 2023 الكاتب مشاركة قام بنشر مارس 13, 2023 شكرا ادركت الخطأمنى الف شكر ليكم استاذنا الفاضل ولكن فيه ملحوظة عصام كان اخذ اجازة وانتهت وبعد ذلك عصام اخذ اجازة ثانية المقروض هنا ميرحلش الاسم مرة ثانية بل يرحل الاجازة رابط هذا التعليق شارك More sharing options...
أفضل إجابة lionheart قام بنشر مارس 14, 2023 أفضل إجابة مشاركة قام بنشر مارس 14, 2023 Try Sub Test() Dim x, w, ws As Worksheet, lr As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) With ws lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1 x = Application.Match(.Range("D2").Value2, .Rows(6), 0) If Not IsError(x) Then w = Application.Match(.Range("B2").Value, .Range("B7:B" & lr), 0) If Not IsError(w) Then .Cells(w + 6, x).Resize(, .Range("F2").Value).Value = .Range("C2").Value Else .Cells(lr, 1).Value = .Cells(lr, 1).Row - 6 .Cells(lr, 2).Value = .Range("B2").Value .Cells(lr, x).Resize(, .Range("F2").Value).Value = .Range("C2").Value End If End If End With Application.ScreenUpdating = True End Sub 2 رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر مارس 14, 2023 مشاركة قام بنشر مارس 14, 2023 نفس الكود معدل حسب اظروف الراهنة Sub Trhile() Dim ws As Worksheet: Set ws = Sheets("البيانات") Dim sh As Worksheet: Set sh = Sheets("تجميع الغياب") Dim lr&, r&, col& lr = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1 On Error Resume Next r = Range(Cells(7, 2), Cells(7, 2).End(xlDown)).Cells.Find(ws.Range("b2").Value, , , 1).Row On Error GoTo 0 lr = IIf(r = 0, lr, r) ws.Cells(lr, 2) = ws.Range("b2").Value ws.Cells(lr, ws.Range("A6:AG6").Cells.Find(Split(ws.[d2].Value, "/")(1), , -4163, 1).Column).Resize(, ws.[F2].Value) = ws.[C2].Value r = sh.Cells.Find(ws.[b2].Value, , , 1).Row col = sh.Cells.Find(ws.[C2].Value).Column sh.Cells(r, col).Value = ws.[d2].Value sh.Cells(r, col).Offset(, 1) = ws.[e2].Value sh.Cells(r, col).Offset(, 2) = ws.[F2].Value End Sub 1 رابط هذا التعليق شارك More sharing options...
فوزى فوزى قام بنشر مارس 14, 2023 الكاتب مشاركة قام بنشر مارس 14, 2023 ليس لدى مااقوله لكم سوى ادام الله عليكم نعمة العلم وعافية الابدان وحفظكم الله من شرور الدنيا والاخرة امين هذا هو المطلوب 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.