محمد عبد الناصر

السلام عليكم ورحمة الله وبركاته 

اخواتي في الله 

مطلوب كود يقوم بترحيل المكتوب في شيت Main في الخليه C8 الى اسم الشيت المكتوب في الخليه B2 يقوم بترحيلها بالترتيب في العمود B6 

ثم يقوم بنسخ شيت NEW وفتح شيت جديد  باسم الخليه B2 في شيت Main وان امكن ان يعمل ربط تشعبي 

اذا امكن تطبيقها على الملف المرفق 

جعله الله في موازين حسناتكم 

BB.xlsm

ممتاز اخواتي الكرام شكرا استاذ حجازي والف شكر استاذي الفاضل محمد هشام جعله الله في موازين حسناتكم 

منذ ساعه, Foksh said:

وعليكم السلام ورحمة الله وبركاته ,,

حاولت فهم المطلوب بشكل واضح ، وخرجت بهذه الفكرة . حيث انشأت زر للتنفيذ ، يحتوي الكود التالي :-

Private Sub Btn_1_Click()
    Dim wsMain As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetCol1 As String, targetCol2 As String
    Dim sourceCol1 As String, sourceCol2 As String
    
    Set wsMain = ThisWorkbook.Sheets("F")
    
    Dim targetSheetName As String
    targetSheetName = wsMain.Range("F6").Value
    
    On Error Resume Next
    Set wsTarget = ThisWorkbook.Sheets(targetSheetName)
    On Error GoTo 0
    
    If wsTarget Is Nothing Then
        MsgBox " : الورقة المحددة غير موجودة" & targetSheetName, vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    If wsMain.Range("G6").Value = "قوى" Then
        sourceCol1 = "L"
        sourceCol2 = "M"
        targetCol1 = "H"
        targetCol2 = "I"
    ElseIf wsMain.Range("G6").Value = "تامين" Then
        sourceCol1 = "O"
        sourceCol2 = "P"
        targetCol1 = "H"
        targetCol2 = "I"
    Else
        MsgBox "يجب اختيار 'قوى' أو 'تامين' في الخلية G6", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    wsMain.Range("H6:I" & wsMain.Rows.Count).ClearContents
    
    lastRow = wsTarget.Cells(wsTarget.Rows.Count, sourceCol1).End(xlUp).Row
    lastRow = Application.WorksheetFunction.Max(lastRow, wsTarget.Cells(wsTarget.Rows.Count, sourceCol2).End(xlUp).Row)
    
    For i = 6 To lastRow
        If wsTarget.Range(sourceCol1 & i).Value <> "" Then
            wsMain.Range(targetCol1 & (i - 0)).Value = wsTarget.Range(sourceCol1 & i).Value
        End If
        
        If wsTarget.Range(sourceCol2 & i).Value <> "" Then
            wsMain.Range(targetCol2 & (i - 0)).Value = wsTarget.Range(sourceCol2 & i).Value
        End If
    Next i
    
    MsgBox "تم نقل البيانات بنجاح", vbInformation + vbMsgBoxRight, ""
End Sub

 

جرب المرفق وأخبرنا بالنتيجة ..

 

BB.zip 20.36 kB · 0 downloads

اخي الكريم هل من الممكن ان تكون معادله وليس كود ؟ 

بارك الله لك في علمك ومجهودك وحفظك الله من كل شر

متابعه

السلام عليكم ورحمة الله وبركاته 

اخواتي في الله في الملف المرفق يوجد في العمود B مجموعه من ارقام ملفات مسجل بها بيانات 

اريد عند كتابة الرقم في الخليه F6 و كتابة نوع البيان بجانبها في الخليه G6 ان يقوم باستدعاء البيانات من شيت رقم الملف ويكتبها في العمود H6 و i6 
الملف المرفق موضح المطلوب

شكرا مقدما لكل من يساهم في حل المطلوب

BB.xlsx

الحمد لله دائما وابدا

3 ساعات مضت, عبدالله بشير عبدالله said:

السلام عليكم 

حسب فهمي لطلبك  Jجمع رواتب  الموظف ووضعها في M6 وجمع سلفه ووضعها في M7 وذلك حسب الاسم في I6

ان كان كذلك جرب الملف 

القائمة في I6 يتم تحديثها  عند الدخول الى الورقة لوحدها

DC (1).xlsb 23.17 kB · 1 download

بالضبط ولكن اريدها معادله وليس كود فعند تغيير الاسم لا يقم بالمطلوب اريد عندما اقوم بتغيير الاسم يقوم بالامر وليس عند دخول الورقه

5 دقائق مضت, AbuuAhmed said:

تعديلي كان في العمود (J) فقط.

هل من الممكن التعديل في العمود M6 لكي يجمع رواتب او سلف كل شخص

5 دقائق مضت, AbuuAhmed said:

المرفق حسب فهمي لمطلبك:

DC_02.xlsx 23.73 kB · 1 download

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

6 دقائق مضت, AbuuAhmed said:

المرفق حسب فهمي لمطلبك:

DC_02.xlsx 23.73 kB · 1 download

يوجد خطأ في المعادله المكتوبه في الخليه M6 يقوم بجمع كل الرواتب اريد فقط يجمع راتب محمود فقططط او مصطفى فقققط على حسب الاسم المكتوب في الخليه I6

في الملف المرفق اريد جمع الراتب الخاص بمحمود فقط او سلف محمود فقط في الخليه M6 اعتمادا على الاسم المكتوب في الخليه I6 اعتمادا على العمود d يقوم بجمع المبالغ التي صرفت للموظف محمود او الاسماء المكتوبه في العمود d

DC (1).xlsx

منذ ساعه, عبدالله بشير عبدالله said:

السلام عليكم 

بعد اذن استاذنا الفاضل محمد هشام

يالنسبة لسؤالك اضغط على 

Ctrl + Shift + Enter

 اطلعت على ملفك وما قام به الاستاذ محمد هشام كاقي ووافي 

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

ارفق لك ملفا  بواسطة كود يعمل تلقائيا عند الاختيار من القائمة الى جانب يقوم بتحديث القائمة اذا اضفت لها بيانا جديدا او اكثر

DC.xlsb 22.03 kB · 2 downloads

 

ماشاء الله بارك الله في علمك وعقلك استاذ عبدالله وجعله في ميزان حسناتك

@محمد هشام.
اخي الكريم عند التعديل على هذه المعادله يختفي رمز {} ماذا اضغط بعد تعديل المعادله ؟
 

=IFERROR(INDEX(D$6:D$139,SMALL(IF($H$6=$C$6:$C$139,ROW($D$6:$D$139)-5),ROW(J1))),"")

ماشاء الله بارك الله فيك استاذ محمد هشام

السلام عليكم ورحمة الله وبركاته

الكود هذا يقوم باخذ الصف كوبي اذا تحقق شرط كتابة اسم محدد وهو ( دريم ) يقوم بنسخ الصف باكمله وينقله كوبي الى شيت "دريم"

اريد تعديل ان يقوم بنقل الصف من الخليه B الى الخليه G فقطط 

Sub CopyRowsmaktab()
    Dim LR As Long, I As Long, X As Long
    LR = Sheets("Main").Cells(Rows.Count, "B").End(xlUp).Row
    X = 6
    Application.ScreenUpdating = False
        Sheets("دريم").Rows("6:1000").ClearContents

        
        For I = 6 To LR
            If Cells(I, "B").Value = "دريم" Then Rows(I).Copy Sheets("دريم").Range("A" & X): X = X + 1
 
            

        Next I
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

28 دقائق مضت, محمد هشام. said:

 

 

 

 

DC.xlsx 23.05 kB · 1 download

شكرا اخي الكريم بارك الله في علمك وعقلك الف شكر

9 دقائق مضت, محمد هشام. said:

وعليكم السلام ورحمة الله تعالى وبركاته 

 الإسم 

=IFERROR(INDEX(D$6:D$14, SMALL(IF((C$6:C$14=H$6)*(COUNTIF($K$5:K5,
D$6:D$14)=0), ROW(D$6:D$14)-ROW(D$6)+1), ROW(1:1))), "")

إجمالي الإسم 

=IF(K6<>"",SUMIF($D$6:$D$139, K6, $E$6:$E$139),"")

إجمالي البيان 

=SUMIF(C6:C139, H6, E6:E139)

 

DC.xlsx 19.54 kB · 0 downloads

هو المطلوب تماما ولكن لا ياتي باسماء كل العاملين فقط محمو

 ومصطفى ومتبقي شريف وانا سوف اقوم بكتابة اكثر من 20 عامل اريد ان يكتبهم جميعا بارك الله فيك

السلام عليكم ورحمة الله وبركاته

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

اريد في الخليه H6 عندما اكتب كلمة ( مكتب ) ان يجمع لي كل مصروفات المكتب وايضا ان يكتب اسماء العاملين في الخليه k1 ويجمع لي مصروف كل عامل بجانب الاسم وايضا عندما اكتب لله ان يجمع لي كل مصروفات لله وهكذا

الملف المرفق موضح المطلوب

DC.xlsx

ماشاء الله استاذ محمد صالح و استاذ محمد هاشم جعله الله في ميزان حسناتكم

هذا الكود يقوم بربط الشيتات ب Sheet1

اريد ان يقوم بعمل الكود وان لا ينفذ الامر على sheet2 و sheet7 و sheet3

وان يجعل حجم الخط في الخليه E1 في كل الشيتات 30 

Sub ww()


Dim h As Worksheet, sh As Worksheet, j As String
Dim k As String, x As String, d As String
Set h = Sheets("Sheet1")

For Each sh In Sheets
If Not sh.Name = "Sheet1" Then
j = sh.Index + 2
k = sh.Name
x = "'" & k & "'!a1"
d = "'Sheet1'!a1"
h.Hyperlinks.Add h.Cells(j, 1), "", x, k, k
sh.Hyperlinks.Add sh.Cells(1, 5), "", d, "Sheet1", "رجوع"
End If
Next

End Sub

لو امكن ممكن تطبقهالي على الملف المرفق ؟؟ لما بحط المعادلة بيجبلي خطأ

@أ / محمد صالح

السلام عليكم ورحمة الله وبركاته ,,,

في الملف المرفق بيانات لموظفين لدي من سنة 2022 الى سنة 2023 يوجد من الموظفين من ترك الشركة ومن مستمر معي وموظفين جدد اريد الفصل بينهم في كل شيت خاص بالحاله 

ومطلوب كود اخر يقوم بتحديد الموظفين الذي تم زيادة رواتبهم والذي لم يتم زيادة رواتبهم في شيت المعدل 

الملف المرفق موضح المطلوب 
شكرا لكل من ساعدني جعله الله في موازين حسناتكم 

OK.xlsm

ماشاء الله هو المطلوب تمام جزاك الله كل خير 

ماشاء الله استاذ محمد هاشم بارك الله فيك وفي علمك وجعله الله في ميزان حسناتك 

ولكن لماذا يقوم بمسح اي شيت اخر موجود فمثلا يقوم بمسح sheet2 وهو غير مكتوب في العمود C لا اريد ان يتم مسح اي شيت اخر عند تفعيل الكود

السلام عليكم ورحمة الله وبركاته,,,

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

المطلوب ان يقوم بنسخ البيانات وترحيلها الى الشيت المخصص لها حسب المكتوب في العمود C فمثلا في الخلية C4 مكتوب كنوز فيقوم بنسخ الصف الى شيت كنوز الخليه C5 مكتوب ادعية يقوم بنسخ الصف الى شيت ادعية 
ومطلوب ان يجعل العمود B في كل الشيتات size 70 

ويقوم ايضا بنسخ الصف 5 ويضعه في كل الشيتات في الصف رقم 5 

الملف المرفق يوضح المطلوب ..... وجزاكم الله كل خير على مساعدتكم 

Sub CreateSheets()
     
    Dim lra As Integer
    Dim My_Rg As Range
    Dim ListSh As Range
     lra = Cells(Rows.Count, "c").End(xlUp).Row

     Set ListSh = Worksheets("Sheet1").Range("c6:h" & lra)

     
    On Error Resume Next
    For Each My_Rg In ListSh
        If Len(Trim(My_Rg.Value)) > 0 Then
            If Len(Worksheets(My_Rg.Value).Name) = 0 Then
                Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = My_Rg.Value
            End If
        End If
      Worksheets("Sheet1").Select
    Next My_Rg
    
Applications.Calculations = xlCalculationManual
    
     End Sub

اسلاميات.xlsm

السلام عليكم ورحمة الله وبركاته 

مطلوب كود ييقوم بنقل اصفف حسب المكتوب في الخليه a1 في العمود E ويقوم بفتح شيت مخصص حسب الاسم المكتوب في العمود A3:A20000 

الملف المرفق موضح الطلوب

MD.xlsm