محي الدين ابو البشر

🙏

هي (عدد أعمدة) وليس range او cells!!!!!

وعليكم السلام والرحمة كود: Sub test() Dim a Dim x&, i&, c& Dim r As Range Dim firstaddress As String With Sheets("التقرير") a = .Range(.Cells(6, 1), .Cells(6, 3).End(xlDown)) x = .Cells(2, 6) End With With Sheets("كشف الطباعة") Set r = .Columns("a").Find("م", , , 1) If Not r Is Nothing Then firstaddress = r.Address Do [r].Offset(1).Resize(x, UBound(a, 2)) = Application.IfError(Application.Index(a, _ Evaluate("Row(" & c + 1 & ":" & x + c & ")"), [{1, 2,3}]), "") Set r = .Columns("a").FindNext(r) c = c + x Loop Until r.Address = firstaddress End If End With End Sub ترحيل الاسماء.xlsm

عليكم السلام ورحمة الله وبركاته تفضل أخي الكريم Sub test() With Sheets("يومية الحضور والإنصراف").Range("B4:C" & Sheets("يومية الحضور والإنصراف").Cells(Rows.Count, 1).End(xlUp).Row) .Formula = "=IFERROR(VLOOKUP($A:$A,Table9,COLUMN(),0),"""")" .Value = .Value End With With Sheets("رصيد الأجازات").Range("B3:D" & Sheets("رصيد الأجازات").Cells(Rows.Count, 2).End(xlUp).Row) .Formula = "=IFERROR(VLOOKUP($A:$A,Table9,COLUMN(),0),"""")" .Offset(, 3).Resize(, 1).Formula = "=IFERROR(IF(DATEDIF([@[تاريخ التعيين]],$D$1,""D"")/30>3.1,""يستحق"",""""),"""")" .Offset(, 5).Resize(, 1).Formula = "=IF([@[معادلة الرصيد]]=""يستحق"",$O$1+[@[معالجة الرصيد]],0)" .Offset(, 6).Resize(, 1).Formula = "=[@[الرصيد المرحل]]+[@[رصيد 2023]]" .Offset(, 7).Resize(, 1).Formula = "=(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A3,'يومية الحضور والإنصراف'!$H:$H,""أجازة"")+(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A3,'يومية الحضور والإنصراف'!$H:$H,""أجازة مجمعة"")))" .Offset(, 8).Resize(, 1).Formula = "=(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A4,'يومية الحضور والإنصراف'!$H:$H,""أجازة عارضة""))" .Offset(, 9).Resize(, 1).Formula = "=IF(E3=""يستحق"",$N$1-[@[ عارضة]],0)" .Offset(, 10).Resize(, 1).Formula = "=(([@[إجمالي الرصيد المستحق]]-([@[ سنوي]]+[@[ عارضة]]+[@[تسوية نقدي]])))-[@[باقي رصيد العارضة]]" .Offset(, 11).Resize(, 1).Formula = "=([@[باقي رصيد السنوي ]]+[@[باقي رصيد العارضة]])" With .Resize(, 12) .Value = .Value End With End With End Sub

بالاذن Book1 (2).xlsx

E2=IF(OR(A2<>"",B2<>""),IF(AND(A2<>"",B2=""),"قبض","صرف"),"") ربما ادرج نوع العملية تلقائي.xlsx

يدوياً؟ قم باختيار الجدول ( ليس من الخلايا وإنما كامل الأسطر) بمعني اضغط على الرقم 1 بجانب الخلية A1 نزولا حتى آخر الجدول) ثم CTR+ Copy ثم right click على أول خلية تريد النسخ فيها وقم باختيار (Insert Copied cells) ويمكن عمل ذلك بماكرو إذا أحببت

السلام عليكم بالأذن من الجميع ممكن تجربة؟ برمجة حساب راتب (1).xlsm

جرب هذا Sub Oval1_Click() Dim xDir As String Dim xFile As String Dim xRow As Long With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Title = "Please select the files" .Filters.Clear .Filters.Add "All supported files", "*.*" If .Show = -1 Then xDir = .SelectedItems(1) xFile = Dir(xDir & Application.PathSeparator & "*.docx") Do Until xFile = "" xRow = 0 On Error Resume Next xRow = Application.Match(xFile, Range("A:A"), 0) If xRow > 0 Then Name xDir & Application.PathSeparator & xFile As _ xDir & Application.PathSeparator & Cells(xRow, "B").Value End If xFile = Dir Loop End If End With End Sub

الحمد لله ولك تحياتي وكل عام وأنتم بخير

عليكم السلام وارحمة وكل عام وأنتم بألف خير أخي الكريم في كود الترحيل .Cells(x + 1, 15) = mat وفي كود المسح myArea(28, 15) = "" ولك تحياتي

بارك الله

بسيطة Sub protect_sh() Dim i& Dim p As String p = InputBox("ÃÏÎá ßáãÉ ÇáÓÑ") For i = 1 To Sheets.Count Sheets(i).Protect p Next End Sub Sub unprotectsh() Dim i& Dim p As String p = InputBox("ÃÏÎá ßáãÉ ÇáÓÑ") For i = 1 To Sheets.Count Sheets(i).Unprotect p Next End Sub

عليكم السلام تقضل أخي الكريم عسى المطلوب طلب ترحيل بالاسم والتاريخ.xlsm

الحمد لله ولك مثل ما دعوت وأكثر