تعديل كود الاستاذ حسونة ليتماشى مع ملفى

[عمر الجزاوى]

أستاذ حسونة نسخت كود حضرتك حاولت اعدله واطبقه على شيت الفاتورة اللى هيرحل الى شيت القيمة المضافة حسب الشهر علشان ارحل خلايا معينة ولكن لم افلح ممكن بعد اذنك تعديل الكود حتى يرحلى الخلايا H3 و الخلية F5 والخلية B7 والخلية H23 والخلية H25 والخليه H26 والخلية H27 الترحيل يكون حسب الشهر الموجود في الخلية j1  الى شيت القيمة المضافة المقسم الى 12 شهر كل شهر فى شيت وانا اسف على تعب سيادتكم

الاستعلام.xlsm القيمة_المضافة.xlsm

[حسونة حسين]

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

واضح انك نسيت تحيه الاسلام يا اخى عمر

تفضل اخى الكريم 

Sub test()
    Dim WB As Workbook, WS As Worksheet, SH As Worksheet, LR As Long
    Set SH = ThisWorkbook.Worksheets("فاتورة")
    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "القيمة_المضافة.xlsm", False)
    For Each WS In WB.Worksheets
        If SH.Range("J1") = WS.Name Then
            LR = Application.Max(5, WS.Cells(Rows.Count, 1).End(xlUp).Row) + 1
            WS.Range("A" & LR).Value = LR - 5
            WS.Range("B" & LR) = SH.Range("H27")
            WS.Range("C" & LR) = SH.Range("H23")
            WS.Range("D" & LR) = SH.Range("H25")
            WS.Range("E" & LR) = SH.Range("H26")
            WS.Range("F" & LR) = SH.Range("H3")
            WS.Range("G" & LR) = SH.Range("B7")
            WS.Range("H" & LR) = SH.Range("F5")
            WS.Range("H6:H" & LR).NumberFormat = "[$-1010000]yyyy/mm/dd;@"
            GoTo 86
        End If
    Next WS
86  WB.Close Savechanges:=True
End Sub

 

يرجي تعديل عنوان الموضوع لاسم مناسب للموضوع ليسهل في عمليه البحث للاعضاء

[عمر الجزاوى]

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

[حسونة حسين]

وجزاكم مثله اخى الكريم 

الحمد لله الذي بنعمته تتم الصالحات