تعديل فى كود ترحيل من صفحة الى عدة صفحات من خلال القائمة المنسدلة

[abouelhassan]

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

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

تحديد خلية واحدة اكتب بها التاريخ وخلية اكتب فيها رقم المستند 

واختار الصفحات عادى من كل سطر واضيف المبالغ فيتم الترحيل الى كل الصفحات 

Sub Test()
    Dim x, ws As Worksheet, sh As Worksheet, sName As String, lr As Long, r As Long, m As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets(1)
        lr = ws.Cells(25, 1).End(xlUp).Row
        For r = 3 To lr
            sName = CStr(ws.Cells(r, 5).Value)
            If Evaluate("ISREF('" & sName & "'!A1)") Then
                Set sh = ThisWorkbook.Worksheets(sName)
                m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                x = Application.Match(ws.Range("G2").Value, sh.Rows(1), 0)
                If Not IsError(x) Then
                    sh.Cells(m, 1).Resize(1, 4).Value = ws.Cells(r, 1).Resize(1, 4).Value
                    sh.Cells(m, x).Value = ws.Cells(r, 6).Value
                End If
            End If
        Next r
    Application.ScreenUpdating = True
        Range("A3:f24").ClearContents

    MsgBox "Done...", 64, ""
End Sub

اخيكم بحاجة للمساعدة فى هذا الموضوع مع الشكر

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

[abouelhassan]

للرفع رفع الله مقداركم