Foksh

ارفق ملف يحتوي أكثر من شرط أخي الكريم ، مع العلم ان ارتفاع جزء التفاصيل سيكون حسب ارتفاع المربعات النصية !!!!!!

12 دقائق مضت, احمد الحسيني said:

بسم الله ما شاء الله... 

 

شكراً لك مرورك أخي الكريم  ..

انتظر التحديث الجديد  

7 ساعات مضت, moho58 said:

السلام عليكم الإخوة الأفاضل في هذا المنتدى الجميل

 

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

كفكرة بسيطة ، في مديول جديد ، استعمل الدالة التالية :-

Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, nomRapport As String) As Single
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim hauteur As Single
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset( _
        "SELECT hauteur_rang FROM tab_hauteur_range " & _
        "WHERE annee = '" & annee & "' " & _
        "AND grade = '" & grade & "' " & _
        "AND wilaya = '" & wilaya & "' " & _
        "AND nom_raport = '" & nomRapport & "'", dbOpenSnapshot)
    
    If Not rs.EOF Then
        hauteur = rs!hauteur_rang * 567
    Else
        hauteur = 0.7 * 567
    End If
    
    rs.Close: Set rs = Nothing: Set db = Nothing
    GetTxtHeight = hauteur
End Function

ثم في حدث الزر عند التقر لفتح التقرير :-

Private Sub أمر2_Click()
    Dim h As Single
    Dim annee As String, grade As String, wilaya As String, rapport As String
    
    rapport = "rap_pv"
    
    annee = Me.annee
    grade = Me.grade1
    wilaya = Me.wilaya1
    
    h = GetTxtHeight(annee, grade, wilaya, rapport)
    
    TempVars!Temp_Hauteur = h
    
    DoCmd.OpenReport rapport, acViewPreview
End Sub

وفي حدث عند الفتح للتقرير :-

Private Sub Report_Open(Cancel As Integer)
    Dim h As Single
    If Not IsNull(TempVars!Temp_Hauteur) Then
        h = TempVars!Temp_Hauteur
    Else
        h = 0.7 * 567
    End If
    Me.nom.Height = h
    Me.prenom.Height = h
End Sub

مع ضرورة عدم تمكين  لمربعي النص ( nom و prenom )

مع العلم ان الفكرة قابلة للتطوير بالتحكم بحجم الخط أيضاً 😉 

الملف :-

baseM.zip

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

مشاركتكم الأفكار ، بأن تكون الدالة معتمدة على الـ Tag بالإضافة الى الجدول ( أو بدونه بتضمين اللون في الاستدعاء ) ، بحيث كل مجموعة عناصر مشتركة في Tag واحد تأخذ نفس اللون بغض النظر عن موقعها !!

💡 مجرد فكرة ، ولكني نفذت مشابهاً لها في تغيير لون خلفية وخط عناصر من نوع ليبل حسب شرط محدد في مشروع لإدارة تأجير الشقق الفندقية والعقارات ،،

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

الف مبروك للاستاذ فادي الترقية المستحقة

بارك الله بكم استاذي الفاضل 😇..

شكراً لك 💐

8 ساعات مضت, ابوخليل said:

حسب انظمتهم  من وقع حضور ولم يوقع انصراف يعتبر غائبا

ماذا لو حصل خلل أو انقطاع الكهرباء أو تلف ... الخ !!!!

رغم أنك وأعتقد ذلك من خلال المكتبات أنك أسست للربط بجهاز البصمة ، فهل الخلل الحاصل سيتحمله الموظف ويدخل في متاهة أثبت أو إحلف 😅 ..... الخ.

ما لم تكن هناك حلول لهذه الإحتمالات قد تم أخذها في الحسبان ، فرأيي أن الأنظمة التي يقود مركبها جهاز قابل للخطأ = غير عادلة.

أشعر انني انفعلت قليلاً 🤣😂

هي وجهة نظر ما لم يكن معلمي قد خبأ لنا إجابة تنتظر هذا التعليق .

الأكواد جميلة جدا ، وفكرتها جميلة وقد ألمت بجميع النواحي البرمجية التي تحدثتم عنها سابقاً.

6 ساعات مضت, Hamtoooo said:

تمت التجربة مع بعض التعديلات البسيطه وكانت فعاله

الحمد لله على نعمه..

لا تنسى إغلاق الموضوع أخي الكريم 🤗 

3 ساعات مضت, ابو جودي said:

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

جزاكم الله خيـــــــرا
اسال الله تعالى ان يعفو ويغفر لوالدك و والدى ويرحمهم رحمة واسعة وكل المسلمين الاحياء منهم والاموات وان يسكنهم الفردوس الاعلى ان شاء الله

تسلم ايدك يا فنان

حبيبي يا هندسة 🤗

اللهم تقبل دعائكم بظهر الغيب 🤲🏻

3 ساعات مضت, Lamyaa said:

شكرا على المشاركة ورحم الله والديك

شكراً لمرورك اختنا الكريمة ،، ولكم من الدعاء النصيب الأكبر 😇

6 دقائق مضت, mohammed farhat said:

جزاكم الله كل خير بشمهندس فادي هدية أكثر من رائعة 

وإياكم أخي الكريم .. 

شكراً لمرورك العطر 

كثيرون استفسروا عن كيفية اختيار اسم مخزن في الجدول ، بدلاً من كتابة الرقم بشكل يدوي .

ولذا قد صورت هذا الفيديو كفكرة سريعة على الخطوات - وصولاً إلى النتيجة ,,

طبعاً كلمة كثيرون = في مجموعة الواتس أب الخاصة بقسم آكسيس 

وليس في المنتدى 🤣

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

وبما اني اتابع من الجوال ، ولم استطع من رؤية الملف . اعتقد ان هناك أكثر من فكرة !!!

الأولى قد تعتمد على دالة تتفقد جميع العناصر ذات النوع "مربع نص" بأنها تحتوي قيم وغير فارغة . وهذا قد يسبب مشكلة لأنه حينها لن يميز بين مربعات النص التي تريدها من مربعات نص أخرى على سبيل المثال .

الثانية أنه عند الحفظ وقبل إتمام عملية الحفظ التأكد من مربعات النص التي لها مصدر بيانات مرتبط بحقل وليس مربعات النص الغير مضمنة بمصدر بيانات ، وهنا قد تكون مشكلة أيضاً .

الثالثة وما أرجحها بشكل أفضل وأقوى ، وهو من خلال الـ TAG . بحيث تضع وسماً لجميع مربعات النص التي تريدها أن يتم التحقق منها ولنفترض = Ham

حيث من خلال زر الحفظ نستعمل كود بهذا الشكل تقريباً - ما لم أكن مخطئاً في بعض الأجزاء ..

dim ctl as control, missing as string
for each ctl in me.controls
if lcase(trim(ctl.tag)) = "Ham" then
if nz(ctl.value, "") = "" then
missing = missing & vbcrlf & ctl.name
end if
end if
next
if missing <> "" then
msgbox " :  الحقول التالية فارغة" & vbcrlf & missing, vbinformation+ vbmsgboxright, ""
exit sub
end if
docmd.runcommand accmdsaverecord
docmd.gotorecord,,acnewrec

طبعاً ، إذا كنت من الأشخاص الذين يتركون اسم مربع النص كما هو من مصدره من الجدول ، فقد قمت بإضافة فكرة تحديد اسماء المربعات النصية التي لم يتم ادخال بيانات فيها .

بكل الأحوال جرب وأخبرنا بالنتيجة ، عل أحد الأساتذة والأخوة يتابع معك من كمبيوتر 🥴

على كل حال جرب 

خطر على بالي نقطة أخرى من خلال السطر :-

missing = missing & vbcrlf & ctl.name

بأن نستبدله بالسطر التالي :-

missing = missing & vbcrlf & ctl.controls(0).caption

فهنا سيأقرأ التسمية ( label ) المرتبطة بكل مربع نص بدلاً من اسم مربع النص نفسه .

أخواني وأساتذتي ومعلمينا ( دون استثناء )

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

وهذا الإعتقاد منطقي 😁 . إلا انه وبهذه التحديثات - واتمنى - أنه قد تم التعامل مع هذه الأخطاء بهذه النسخة المطورة والمحسنة .

 الإضافات التي تم تأمينها في هذه النسخة :-

     التعامل مع المرفقات بسلاسة وسهولة من خلال فكرة نسخ المرفق ولصقه في تطبيق الواتس اب ( سطح المكتب ) ، وليس من خلال المسار 😁 .

     إمكانية الإرسال لأكثر من رقم دفعة واحدة . افصل بين الرقمين بإشارة / فقط .

     إمكانية إضافة التعبيرات Emoji وإرسالها ضمن الرسائل في الواتس أب . من خلال زر 

     زر لمسح محتوى الرسالة تهيئةً لإرسال جديد . من خلال الزر 

     تضمين محدد لحجم الملفات والمرفقات المرسلة . ( خاص بأصحاب التطويرات الذين يريدون تقييد وإلزام المستخدم بحجم محدد ) .

     استخدام تايمر متغير للتعامل مع الإرسالات المتعددة لأكثر من رقم .

     واجهة محاكية وجذابة للبرنامج .

     لا تحتاج جداول أو مكتبات خارجية .... إلخ .

     تم كتابة الدوال والأكواد بطريقة تسهل على المطورين إعادة الهيكلة والتصميم حسب حاجتهم في برامجهم .

 واجهة البرنامج :-

:-

      ضرورة تثبيت برنامج واتس اب سطح المكتب من متجر ويندوز .

      التأكد من فتح تطبيق الواتس أب سطح المكتب لديك ، لتلافي المشاكل عند اختلاف سرعة إستجابة الكمبيوتر من مستخدم لآخر .

WhatsApp Sender 2025.zip

الان, ابو جودي said:

ما هو لو حد رخم زى حلاتى ممكن يكون عامل حماية للمجلد من حذف ما فيه 

تعملها ويطلع منك 

1 ساعه مضت, ابو جودي said:

طيب كنت قد كتبت داله تعتمد على تشفير : MD5

تفتكر هيكون آمن إذا استخدم لوحده بدون ( Salt ) ؟؟

وحبة الملح دي هي اللي ممكن تزيد من مستوى الحماية في كلمات المرور ..

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

باذن الله لي عودة متأنية لباقي ردكم استاذنا الفاضل

 

ننتظر عودتكم بموضوع منفصل للإفادة 😇

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

مع ان مثل هذه المشاركات لا تجد القبول او الاهتمام من بعض الاعضاء وتمر مرور الكرام

 

للأسف مع تحفظي ، الكثير من المواضيع يُـمَـرُّ عليها مرور الكرام ... 😅

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

فمن خبرة سنوات طويلة نسبة كبيرة من المبرمجين تهتم بامن البرنامج اكثر من اهتمامها بامن البيانات

 

نعم صحيح ، وانا كنت أحدهم على فكرة هههههه

إلا أنني توجهت من فترة الى تطبيق الحماية على البيانات والإهتمام بأمانها بجانب الإهتمام بأمن البرنامج ( مشاريعي الخاصة للأعضاء طبعاً وليس ما أشاركه هنا )

دمتم بخير 😇

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

اخي الكريم ،

اهتمامك بمواضيعك من حيث العنوان الصحيح والمناسب يساعدك لاحقاً على أن تجد المساعدة بشكل أسرع .

على العموم ، اذا كان اصدار الويندوز الذي تم تثبيته = ويندوز 10 أو أحدث ، فراجع هذا الرابط من بدايته ..

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

أخي الكريم فعلاً الكثير من المواضيع التي تحدثت عن هذه المشكلة ،،

حاول رفع ملفك على جوجل درايف أو mediafire  ، وارسل الرابط.

13 دقائق مضت, شايب said:

ونكتفي بهذا القدر عن الرمز (') وقد نتحدث غن رمز اخر لايقل خطورة

 

ما شاء الله ، مبدع فيما طرحت .

أثار الموضوع اهتمامي سابقاً في مناقشة سابقة ومداخلة قوية لك ، مما جعلني أتحرى عن موضوع الحقن بشكل عميق وأحاول تنفيذه في مشاريعي تالياً ..

ومن سياق الحديث الذي طرحته ، اعتقد أن استخدام المعلمات بدلاً من سلاسل نصية سيكون من خطوات الأمان التي قد يجب تنفيذها .

أيضاً على ما أعتقد استخدامنا لمطهرات النصوص قد يأتي بنتيجة جيدة ومساعدة ,,

على سبيل المثال ، هذه فكرة بسيطة أيضاً وقد تكون قابلة للتطوير والتحديث بشمولية ,,

If InStr(Me.txtUser, "'") > 0 Or InStr(Me.txtUser, ";") > 0 Then
    MsgBox "تم استخدام رموز غير مسموح بها في اسم المستخدم", vbExclamation
    Exit Sub
End If

ولهذا السبب كنت قد استخدمت محاولة لم أقم بتجربتها بعد ، على أحد المشاريع باستخدام هذه الدالة :-

Public Function Sanitizer(ByVal userInput As String, Optional ByVal context As String = "sql") As String
    Dim sanitized As String
    sanitized = Trim(userInput)
    
    Select Case LCase(context)
        Case "sql"
            sanitized = Replace(sanitized, "'", "''")
            sanitized = Replace(sanitized, ";", "")
            sanitized = Replace(sanitized, "--", "")
        
        Case "name"
            sanitized = Replace(sanitized, "'", "")
            sanitized = Replace(sanitized, ";", "")
            sanitized = Replace(sanitized, "*", "")
            sanitized = Replace(sanitized, "=", "")
        
        Case "pure"
        
        Case Else
            sanitized = Replace(sanitized, "'", "''")
    End Select

    Sanitizer = sanitized
End Function

وعلى سبيل المثال كإستخدام في الاستعلامات :-

Dim filter As String
filter = "[U_UserName]='" & Sanitizer(Me.txtUser, "sql") & "' AND [U_Password]='" & Sanitizer(Me.txtPass, "sql") & "'"
DoCmd.OpenForm "frmDashboard", , , filter

وكمثال على ما طرحته سابقاً لفتح نموذج بفلترة ..

DoCmd.ApplyFilter , "[U_UserName]='" & Sanitizer(Me.txtSearch, "sql") & "'"

أو حتى في نموذج تسجيل الدخول لاسم المستخدم ، كانت المحاولة :-

Dim newUser As String
newUser = Sanitizer(Me.txtNewUser, "name")

هذه كانت الفكرة التي خطرت لي ، ولكن لاحقاً قمت بتحديثها لإظهار رسالة تحذيرية تلقائية إذا تم رصد مدخل خطير أو محاولات حقن نصية 😁

منذ ساعه, محمد عبد الناصر said:

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

 

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

في مرفقك ، الورقة "MD1 15-2020-16" موجودة في الأساس ، وأنت تريد ترحيل البيانات اليها مسبقاً ، ثم تريد انشاء نسخة من الورقة Main بنفس الاسم الموجود في الخلية B2 في Main صحيح !!!!

وضحها اذا سمحت 😅

8 ساعات مضت, Abaas said:

للرفع

تفضل أخي الكريم ، محاولتي البسيطة . حيث في الورقة الثانية = موقف الغياب اليومي ، قمت بإضافة زر للتحديث ، وتم استدعاءه للدالة التي تم انشاؤها في مديول عام :-

Sub ExtractAbsentEmployees()
    Dim wsMain As Worksheet
    Dim wsReport As Worksheet
    Dim targetDate As Date
    Dim dayNum As Integer
    Dim targetCol As Integer
    Dim lastRow As Long
    Dim i As Long
    Dim reportRow As Long
    
    Set wsMain = ThisWorkbook.Sheets("MainSheet")
    Set wsReport = ThisWorkbook.Sheets("موقف الغياب اليومي")
    
    wsReport.Range("A5:D" & wsReport.Rows.Count).ClearContents
    
    targetDate = wsReport.Range("C2").Value
    dayNum = Day(targetDate)
    
    targetCol = 3 + dayNum
    
    If targetCol < 4 Or targetCol > 34 Then
        MsgBox ".تاريخ غير صالح يجب أن يكون اليوم بين 1 و 31", vbExclamation
        Exit Sub
    End If
    
    lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row
    
    reportRow = 5
    
    For i = 4 To lastRow
        If wsMain.Cells(i, targetCol).Value = "غ" Then
            wsReport.Cells(reportRow, 1).Value = wsMain.Cells(i, 1).Value
            wsReport.Cells(reportRow, 2).Value = wsMain.Cells(i, 2).Value
            wsReport.Cells(reportRow, 3).Value = wsMain.Cells(i, 3).Value
            wsReport.Cells(reportRow, 4).Value = targetDate
            reportRow = reportRow + 1
        End If
    Next i
    
    If reportRow = 5 Then
        MsgBox "لا يوجد موظفين متغيبين في هذا التاريخ", vbInformation
    End If
End Sub

وفي الورقة الثالثة "موقف الغياب الشهري" ، أيضاً تم انشاء زر لاستدعاءه الدالة التالية من نفس المديول :-

Sub GenerateMonthlyAbsenceReport()
    Dim wsMain As Worksheet
    Dim wsReport As Worksheet
    Dim startDate As Date, endDate As Date
    Dim currentDate As Date
    Dim dayNum As Integer, targetCol As Integer
    Dim lastRow As Long, reportRow As Long, i As Long
    Dim empName As String, empJob As String
    Dim dateList As String, dayList As String
    Dim dateCount As Integer
    Dim dayName As String
    
    Set wsMain = ThisWorkbook.Sheets("MainSheet")
    Set wsReport = ThisWorkbook.Sheets("موقف الغياب الشهري")
    
    If Not IsDate(wsReport.Range("C2").Value) Or Not IsDate(wsReport.Range("C3").Value) Then
        MsgBox "الرجاء إدخال تاريخين صالحين في الخلايا C2 و C3", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    startDate = wsReport.Range("C2").Value
    endDate = wsReport.Range("C3").Value
    
    If startDate > endDate Then
        MsgBox "خطأ: تاريخ البداية يجب أن يكون قبل تاريخ النهاية", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With wsReport
        .Range("A6:F" & .Rows.Count).ClearContents
        .Range("6:" & .Rows.Count).RowHeight = 15
    End With
    
    lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row
    reportRow = 6
    
    For i = 4 To lastRow
        empName = wsMain.Cells(i, 2).Value
        empJob = wsMain.Cells(i, 3).Value
        
        If empName = "" Then GoTo NextEmployee
        
        dateList = ""
        dayList = ""
        dateCount = 0
        
        currentDate = startDate
        Do While currentDate <= endDate
            dayNum = Day(currentDate)
            targetCol = 3 + dayNum
            
            If targetCol >= 4 And targetCol <= 34 Then
                If wsMain.Cells(i, targetCol).Value = "غ" Then
                    dayName = wsMain.Cells(2, targetCol).Value
                    
                    If dateList <> "" Then
                        dateList = dateList & vbLf & Format(currentDate, "yyyy-mm-dd")
                        dayList = dayList & vbLf & dayName
                    Else
                        dateList = Format(currentDate, "yyyy-mm-dd")
                        dayList = dayName
                    End If
                    dateCount = dateCount + 1
                End If
            End If
            
            currentDate = DateAdd("d", 1, currentDate)
        Loop
        
        If dateCount > 0 Then
            With wsReport
                .Cells(reportRow, 1).Value = reportRow - 5
                .Cells(reportRow, 2).Value = empName
                .Cells(reportRow, 3).Value = empJob
                .Cells(reportRow, 4).Value = dateCount
                .Cells(reportRow, 5).Value = dateList
                .Cells(reportRow, 6).Value = dayList
                
                .Cells(reportRow, 5).WrapText = True
                .Cells(reportRow, 6).WrapText = True
                
                If dateCount > 1 Then
                    .Rows(reportRow).RowHeight = 15 * dateCount
                End If
            End With
            
            reportRow = reportRow + 1
        End If
        
NextEmployee:
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    If reportRow > 6 Then
'        MsgBox "تم إنشاء التقرير بنجاح", vbInformation + vbMsgBoxRight, ""
    Else
        MsgBox "لا توجد أيام غياب في الفترة المحددة", vbInformation + vbMsgBoxRight, ""
    End If
End Sub

وتركت لك التعديل متاحاً من خلال تحديد الصف أو العمود ... إلخ . وهذا ملفك بعد التعديل . راجعه وأخبرنا بالنتيجة  ..

موقف غياب موظفين.zip

تحويل الدالة الى دالة عامة ، يتم استدعائها في أي نموذج ، توسيع الفكرة

اختيار التاريخ لا يعمل بشيت b-c-d.xlsm

ملاحظة مهمة ، يجب ان يكون الـ CheckBox بجانب الخلية المستهدف إدرا الوقت والتاريخ فيها . أي على يسار الخلية

وإذا كانت الخلية المستهدفة على اليسار ، نقوم باستبدال الجزء

+1

الى

-1

في الدالة داخل المديول

قد سبقني السباقون الأساتذة .. ما شاء الله عليهم ..

عذراً للتأخر في الرد ، ولكن يبدوا أنهم قد أجادوا بما طرحوا ، ويسعدني نقلك للإجابة لأي حل آخر تراه مناسباً لك ( بصدر رحب طبعاً )  .

2 ساعات مضت, ابوخليل 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