كود للترحيل

[الشيباني1]

اخواني الاعزاء تحية طيبه في المرفق كود يقوم بترحيل بيانات الى اوراق تتضمن اشهر السنه ارجو التفضل بالمساعده بكود آخر يقوم بترحيل هذه البيانات الى ورقة ( الخلاصه ) حسب الترتيب الظاهر فيها مع الامتنان

monthly report.zip

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

السلام عليكم

على السريع

كود المسح الترحيل لورقة الخلاصة

Sub delete2()

Sheets("خلاصة").Range("B4:BH1000").ClearContents


End Sub

Sub test2()

Dim m As Integer, c As Integer, Last As Integer

Dim cRng As Range, rngLoopRange As Range

'''''''''''''''''''''

With Sheets("MAIN")

Set cRng = .Range("B5:B" & .Range("B" & Rows.Count).End(xlUp).Row)

End With

'''''''''''''''''''''

Application.ScreenUpdating = False



For Each rngLoopRange In cRng

m = Month(rngLoopRange)

c = (m - 1) * 4

c = c + m + 1

With Sheets("خلاصة").Cells(Rows.Count, c).End(xlUp).Offset(1, 0)

rngLoopRange.Resize(, 4).Copy .Cells

End With

Next rngLoopRange




Application.ScreenUpdating = True

Set cRng = Nothing

End Sub

للعلم

تم تعديل باقي الاكواد في المرفق

المرفق 2003

monthly report.rar

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

السلام عليكم

هذا التعديل افضل

Sub test2()

Dim m As Integer, c As Integer

Dim cRng As Range, rngLoopRange As Range

'''''''''''''''''''''

With Sheets("MAIN")

    Set cRng = .Range("B5:B" & .Range("B" & Rows.Count).End(xlUp).Row)

End With

'''''''''''''''''''''

Application.ScreenUpdating = False



For Each rngLoopRange In cRng

    m = Month(rngLoopRange)

    c = ((m - 1) * 5) + 2

    With Sheets("خلاصة").Cells(Rows.Count, c).End(xlUp).Offset(1, 0)

        rngLoopRange.Resize(, 4).Copy .Cells

    End With

Next rngLoopRange




Application.ScreenUpdating = True

Set cRng = Nothing

End Sub

[حمادة عمر]

السلام عليكم

استاذ ومعلم الجميع / عبد الله باقشير

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

ساستفيد منها

ومعجب جدا بعلمك والاكثر منه حسن خلقك فعلا

وحبك لمساعدة الغير

جزاك الله عنا وعن هذا المنتدي كل الخير ان شاء الله

آسف علي الدخول للموضوع ...ولكن اعذروني

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

اخي الفاضل حماده --------حفظك الله

اكرمك الله

احبك الله مثل ما احببتني

جزاك الله خرا

تقبل تحياتي وشكري

[الشيباني1]

استاذنا الكبير رائع كعادتك دائما جزاك الرحمن خير الجزاء وادامك لنا مرجعا