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

عليكم السلام جرب هذا AA.xlsm

السلام عليكم ممكن =COUNTIF(B2:B21,"*")-COUNTIF(B2:B21,("سلطنة عُمان")) أو =COUNTIF(B2:B21,"<>سلطنة عُمان")

السلام عليكم أولا لماذا الشهر 3 بدون بدل السكن والإضافي؟ ثانيا ممكن في ورقة الإجمالي وضع النتائج المتوقعة ثالثا فقط 3 أشهر أم؟؟؟؟ شكرا

بصراحة لا أدري تعمل على 2010 + =SUBTOTAL(9,B3:B7) 2007

مثال =AGGREGATE(9,5,B3:B7)

match & copy (1) (1).xlsm عسى يفي بالغرض

السلام عليكم ضع هذا الكود في Sheet code Private Sub Worksheet_Change(ByVal Target As Range) Set X = Columns(4) For I = 7 To 32 * 3 Step 3 Set X = Union(X, Columns(I)) Next If Not Intersect(X, Target) Is Nothing Then With ActiveSheet.Range(Target.Address) .Offset(, 2) = "=IFERROR(HOUR(" & Target & "-$D$3" & ")*60+MINUTE(" & Target & "-$D$3),"""")" .Offset(, 2).Value = .Offset(, 2).Value End With End If End Sub

طريقة أخرى!! الملف.xlsm

الحمد لله

أها اعتقد اني فهمت بشكل خاطئ المشكلة بالنسخ اذا ربما حسب ما فهمت Myrow = Val(TextBox1.Text)+3 Rows(Myrow).Copy

erow = Sheet3.Cells(Rows.Count,1).End(xlup).Offset(1,0).Row+3

Microsoft Excel Worksheet جديد __.xlsm ?like this perhaps

Sheet3.Range("B9").Value = Sheet1.Range("G6").Value

وجزاكم كل خير نعم تحت التجربة

ربما؟ think 2.xlsm

نسخة من المصنف99-1.xlsm

و عليكم السلام عسى يكون المطلوب المصنف1 (1).xlsm

Sorry المصنف99.xlsm

السلام عليكم آسف على التأخير إليك الملف بزيادة الصفوف إلى 100 و تعديل الكود [b2].Offset(, cc + c - 1).Resize(100, 5) = Application.IfError _ (Application.Index(b, Evaluate("row(" & x & ":" & x + 100 & ")") _ , Array(1, 2, 3, 4, 5)), "") هناك بعض المشاكل في عملية النسخ لا يمكن للكود التعامل معها وسيتم تلوينها باللون الأحمر وستظهر فراغات في الجداول وفي حال تم تصحيح الأخطاء بإعادة تنفيذ الكود سيتم ما هو مطلوب المصنف99.xlsm

السلام عليكم ربما تم التقسيم حسب الجدول Sub test() Dim m As Object, a, i, ii a = Range("a2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1) ReDim b(1 To UBound(a), 1 To 5) With CreateObject("VBScript.RegExp") .Global = True .Pattern = "(\d+){1,2}|(\W+)" For i = 1 To UBound(a) Set m = .Execute(a(i, 1)) For ii = 1 To 3 b(i, ii) = m(ii - 1) Next b(i, 4) = Split(Trim(m(ii - 1)))(0) b(i, 5) = Mid(Trim(m(ii - 1)), Len(b(i, 4)) + 1) Next End With c = 0: cc = 1 For x = 1 To UBound(b) Step 22 [b2].Offset(, cc + c - 1).Resize(22, 5) = Application.IfError _ (Application.Index(b, Evaluate("row(" & x & ":" & x + 22 & ")") _ , Array(1, 2, 3, 4, 5)), "") c = c + 1: cc = cc + 4 Next End Sub

ضم الاسماء بالشكل الذي في المثال في شيت جديد تخزين الملف بصيغة CSV Sub test() Dim a As Variant Dim nm As String Dim i As Long a = Sheets("sheet1").Cells(1, 1).CurrentRegion.Offset(1) For i = 1 To UBound(a) - 1 nm = a(i, 2) a(i, 2) = nm & " (" & "F" & ") " & a(i, 1) a(i, 3) = nm & " (" & "M" & ") " & a(i, 1) Next With Sheets("Output").Cells(2, 1) .Offset(-1) = "Name": .Offset(-1, 1) = "Mobile" .Resize(UBound(a) - 1, 2) = Application.Index(a, Evaluate("row(1:" & UBound(a, 1) & ")"), Array(2, 4)) .Offset(UBound(a) - 1).Resize(UBound(a), 2) = Application.Index(a, Evaluate("row(1:" & UBound(a, 1) & ")"), Array(3, 5)) End With Application.DisplayAlerts = False ThisWorkbook.Sheets("Output").Copy ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "NAMEPHONE", FileFormat:=xlCSV, CreateBackup:=True ActiveWorkbook.Close Application.DisplayAlerts = True End Sub يحفظ الـ CSV في نفس المسار

نفس الكود السابق استبدل wb.ActiveSheet.Range("F10:F11") = a بـ wb.ActiveSheet .Range("D4") = Range("C2") Range("C2").ClearContents

ضع هذا المالف في نفس فولدر الملفات التي تريد النسخ إليها Main.xlsm

المشكلة بالمصطلحات التي تستخدمها لا أدري إذا كان هذا ما تقصد Sub test() Range("C3").Resize(Cells(Rows.Count, 3).End(xlUp).Row - 3) _ .SpecialCells(4).Offset(, -1).Resize(, 8).Delete shift:=(xlUp) ActiveSheet.Range("b3:i10").PrintPreview End Sub