المساعده في عمل زر للترحيل

[حسونة محمد]

السلام عليكم اشكر اعزائي رواد ومشرفي منتدى اوفيسنا الكرام 

ارجو مساعدتي في هذا الملف الذي اريد من خلاله ترحيل البيانات الموجوده في الصفحه 2025 الى عده صفحات بناء على عمود المسؤول والترحيل يكون في السطر كاملا

TR 2025.xlsx

[Foksh]

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

جرب هذه الفكرة البسيطة ، في زر داخل الورقة "2025" ، تم استخدام الكود التالي :-

Sub Btn_Tr_Click()
    Dim wsSource As Worksheet
    Dim lastRow As Long, i As Long
    Dim cityName As String
    Dim wsTarget As Worksheet
    Dim sourceRow As Range
    Dim targetRow As Range
    Dim targetLastRow As Long
    Dim isDuplicate As Boolean
    Dim col As Variant
    Dim keyCols As Variant
    Dim copiedCount As Long, skippedCount As Long
    Dim skippedList As String
    Dim pasteType As XlPasteType
    Dim userChoice As VbMsgBoxResult

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    userChoice = MsgBox("هل ترغب في الترحيل مع التنسيق الكامل" & vbCrLf & _
                        "اضغط 'نعم' للترحيل مع التنسيق ، أو 'لا' للترحيل بالقيم فقط", vbYesNoCancel + vbQuestion + vbMsgBoxRight, "")

    If userChoice = vbCancel Then GoTo Cleanup
    If userChoice = vbYes Then
        pasteType = xlPasteAll
    Else
        pasteType = xlPasteValues
    End If

    Set wsSource = ThisWorkbook.Sheets("2025")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    keyCols = Array(1, 2, 3, 4, 5, 6)

    For i = 3 To lastRow
        cityName = Trim(wsSource.Cells(i, 2).Value)
        If cityName <> "" Then
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Sheets(cityName)
            On Error GoTo 0

            If Not wsTarget Is Nothing And wsSource.Cells(i, 2).Value = wsTarget.Name Then
                Set sourceRow = wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, 10))
                isDuplicate = False

                For targetLastRow = 3 To wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
                    Set targetRow = wsTarget.Range(wsTarget.Cells(targetLastRow, 1), wsTarget.Cells(targetLastRow, 10))
                    isDuplicate = True
                    For Each col In keyCols
                        If sourceRow.Cells(1, col).Value <> targetRow.Cells(1, col).Value Then
                            isDuplicate = False
                            Exit For
                        End If
                    Next col
                    If isDuplicate Then Exit For
                Next targetLastRow

                If Not isDuplicate Then
                    targetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
                    sourceRow.Copy
                    wsTarget.Range("A" & targetLastRow).PasteSpecial Paste:=pasteType
                    Application.CutCopyMode = False
                    copiedCount = copiedCount + 1
                End If
            Else
                skippedCount = skippedCount + 1
                skippedList = skippedList & "- " & cityName & vbCrLf
            End If
        End If
    Next i

    MsgBox "? تم الترحيل بنجاح" & vbCrLf & _
           copiedCount & ":عدد الصفوف المنسوخة " & vbCrLf & _
           skippedCount & ": عدد الصفوف التي تم تجاهلها " & IIf(skippedCount > 0, vbCrLf & ": المدن التي تم تجاهلها " & vbCrLf & skippedList, ""), vbInformation + vbMsgBoxRight, ""

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

End Sub

 

 

TR 2025.zip

[عبدالله بشير عبدالله]

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

جزاك الله خيرا اخونا Foksh

9 ساعات مضت, حسونة محمد said:

ترحيل البيانات الموجوده في الصفحه 2025 الى عده صفحات بناء على عمود المسؤول

ارحو تعديل الكود بحيث يتم الترحيل خسب المسؤول وليس المدن

بالتوفيق استاذنا

[Foksh]

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

ارحو تعديل الكود بحيث يتم الترحيل خسب المسؤول وليس المدن

بالتوفيق استاذنا

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

عدة صفحات = المسؤول

ما علاقة ؟؟؟؟؟ ما الرابط بين الصفحات المسماه بأسماء المدن و عمود المسؤول 🙄

في لهجتنا نقول هذا السؤال طعج مخي 😂

أي أن تفكيري كان يسير في خط مستقيل ولكن هذا السؤال قام بلويه وثنيه وكسره هههههههه

ننتظر التوضيح ما لم يكن لديك حل آخر تتحفني به ، فأنت في مجالك هنا - وتبارك الله عليكم جميعاً - من المميزين في قسم الأكسل  .

[عبدالله بشير عبدالله]

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

سؤال طعج مخي حبة الدواء كيف تعرف مكان الوجع!!

الملف الذي طعج مخك ومخي

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

ننتظر صاحب الطلب الفاضل لزيادة التوضيح
 

[Foksh]

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

سؤال طعج مخي حبة الدواء كيف تعرف مكان الوجع!!

 

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