حسين مامون

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim x, lr, C Dim ws As Worksheet Set ws = Sheets("بيانات") With ws lr = .Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a2:a10000")) Is Nothing Then For x = 2 To lr If Target.Text = .Cells(x, 1).Text Then C = .Cells(x, Columns.Count).End(xlToLeft).Column Range("a1").Resize(, C).Value = .Range("a1").Resize(, C).Value Target.Offset(, 1).Resize(, C).Value = .Cells(x, 2).Resize(, C).Value ' Target.Offset(, 2).Value = .Cells(x, 6).Value ' Target.Offset(, 3).Value = .Cells(x, 7).Value ' Target.Offset(, 4).Value = .Cells(x, 8).Value Exit For End If Next x End If End With End Sub عدل اسم الشيت ان لم يعمل

ارفع ملف به ما تقول في مشاركة منفصلة احسن

ممكن تسرح اكثر لم افهم شيء مما طلبت

تفضل vlook.xlsm

تفضل ربما يكون المرفق ما تريد الاكواد اظنها للاستاد ياسر ابو البراء جزاه الله خير الجزاء قمت بتعديلها حسب طلبك قوائم مترابطة (2).xlsm

المرفق ليس ما تريد بالظبط فقط تجربة بسيطة قريبة من الفكرة تحياتي قوائم مترابطة (2).xlsm

اتمنى ان يكون هذا الشيء ما تريد test (3).xlsm

جرب المرفق mm.xlsm

الاخوة الافاضل لمن يريد معرفة تاريخ نهاية خدمة موظفين اليكم الملف معرفة السن القانوني لتقاعد الموظف.xlsm

جرب هذا الملف TEST TEST.xlsm

تفضل Sub RectangleRoundedCorners222_Click() 'On Error Resume Next 'Sheets("ÍÓÇÈ").Range("A1:h10").ExportAsFixedFormat xlTypePDF, Filename:="e:\pdf\" & Sheets("ÍÓÇÈ").Range("b3").Value & Sheets("ÍÓÇÈ").Range("a3").Value, openafterpublish:=True Dim sh As Worksheet Dim R Dim fil_name Set sh = ThisWorkbook.Worksheets("حساب") fil_name = sh.Range("b3") & " " & sh.Range("a3") Set R = sh.Range("a1:h10") R.ExportAsFixedFormat Type:=xlTypePDF, Filename:="e:\pdf\" & "\" & fil_name sh.Range("a1:h29").PrintOut End Sub

جربته ويعمل 100/100 وهذه نسخة من التخزين حسين 91.pdf

جرب هذا الكود يخزن نسخة في نفس فولدر لي فيه الملف Sub RectangleRoundedCorners222_Click() 'On Error Resume Next 'Sheets("ÍÓÇÈ").Range("A1:h10").ExportAsFixedFormat xlTypePDF, Filename:="e:\pdf\" & Sheets("ÍÓÇÈ").Range("b3").Value & Sheets("ÍÓÇÈ").Range("a3").Value, openafterpublish:=True Dim sh As Worksheet Dim R Dim fil_name Set sh = ThisWorkbook.Worksheets("حساب") fil_name = sh.Range("b3") & " " & sh.Range("a3") Set R = sh.Range("a1:h10") R.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & fil_name sh.Range("a1:h29").PrintOut End Sub

جرب هذا الشيء Sub DAT() Dim x, lr, dt lr = Range("d" & Rows.Count).End(xlUp).Row VBA.Calendar = vbCalHijri For x = 2 To lr Range("g" & x) = Format(DateAdd("m", 0, (Range("b" & x))), "dd-mmm") Next VBA.Calendar = vbCalGreg End Sub

تفضل جرب TEST20212021.xlsm

هذا الملف فيه الكود عندي مظبوط يستخرج يوم من التاريخ ويمكن وضعه في حدث الشيت بدل زر امر Date.xlsm

بالنسبة للبحث جرب المرفق اما السؤال ( عند كتابة التاريخ يستدعي الدرجة في التكست المجاور) فاني لم افهم قصدك ولا ادري اين توجد هذه الدرجات حتى ان وجدت فما شرط استدعائها؟ Video points (1).xlsm

يمكنك عمل هذا بهاذا الكود Sub DAT() Dim x, lr lr = Range("d" & Rows.Count).End(xlUp).Row For x = 2 To lr Range("g" & x) = Format(DateAdd("m", 0, (Range("d" & x))), "m") Next End Sub

حرب ورد علي lable (1).xlsm

تفضل lable (1).xlsm

ربما هذا ما تثصد lable.xlsm

جرب هذا الكود Sub Bevel1_Click() Dim sh For Each sh In Sheets If Format(Sheets("main").Range("m3"), "d") = sh.Name Then sh.Activate Range("I6").Select Exit For End If Next End Sub

تم تغيير تنسيق التاريخ في العموديين فقط مواقع استخدام العناصر 2021 - Copy (1).xlsm

هذه تجربة بحت من خلال فورم بنك.xlsm

استاذ عبدالرحمن999 تقول تريد ترحيل عمودين الى صفحة اخرى ولكن ملفك يحتوي صفحة واحدة حتى ان كانت صفحة ثانية فما هو شرط الترحيل؟ يعني ترد الترحيل بناء على ماذا ؟ ارفع ملفك مرة اخرى مع اضافة الصفحة التي تقصدها وضع فيها بعض البيانات كما تتخيلها تحياتي