ترحيل بشرط

[محمد عدنان]

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

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

الى النموذج المالي علما ان كل صفحة تتسع ل 15 سطر اي اذا كان الترحيل 16 سطر يكون 15 على صفحة و الاخير يبدأ من الصفحة الثانية  و جزاكم الله كل خير 

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

test2024.xlsb

[أبوأحـمـد]

وعليكم السلام

تفضل

Sub TR7EL()
Dim W1, W2 As Worksheet
Dim R, C, x As Long

 Set W1 = Worksheets("الجرد ")
 Set W2 = Worksheets("النموذج المالي")
C = 1
R = 8
For x = 6 To Cells(Rows.Count, "F").End(xlUp).Row

    If W1.Range("S" & x) > 0 Then
    W2.Range("B" & R) = W1.Range("E" & x)
    W2.Range("C" & R) = W1.Range("F" & x)
    W2.Range("D" & R) = W1.Range("D" & x)
    W2.Range("E" & R) = W1.Range("C" & x)
    W2.Range("F" & R) = ""
    W2.Range("G" & R) = W1.Range("T" & x)
    W2.Range("H" & R) = W1.Range("U" & x)
    W2.Range("I" & R) = W1.Range("V" & x)
    W2.Range("J" & R) = W1.Range("W" & x)
    W2.Range("K" & R) = W1.Range("X" & x)
    W2.Range("L" & R) = W1.Range("Y" & x)
    W2.Range("M" & R) = W1.Range("Z" & x)
    
        If C = 15 Then
        R = R + 13
        C = 1
        Else
        R = R + 1
        C = C + 1
        End If
    End If

Next

End Sub

 

[محمد عدنان]

السلام عليكم 

اخ @أبوأحـمـد جزاك الله كل  خير الكود  يعمل و  بارك الله لك و جزاك الله خير على سعة صدرك 

 

تم تعديل أغسطس 6, 2023 بواسطه محمد عدنان