ترحيل معلومات من ورقة إلى أوراق أخرى بشرط

[نينوص06]

تحية طيبة لكل الأعضاء و المشرفين على هذا المنتدى

 

طلبي يتمثل في ترحيل بينات الورقة 1 إلى الأوراق الأخرى بشرط كل معلومة تدهب إلى الورقة المناسبة لها مثلا الأسطر التي تبدأ بالرقم 500 ترحل إلى الورقة 500 وهكذا وهذا بإستعمال ماكرو للترحيل

 

تم تعديل مارس 20, 2014 بواسطه نينوص06

[نينوص06]

الملف لقد نسيته

 

nabil.rar

[وليد فتحي]

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

الاخ الفاضل نينوص06

اتفضل اخي الفاضل لعله طلبك

مع ملاحظة ان الكود مبني على العمود E

تقبل مروري

ترحيل.rar

[أبو حنــــين]

السلام عليكم

لاثراء الموضوع يمكن استعمال هذا الكود

Sub sCopy()

Dim i As Long, r As Long, Lrr As Long, M As Integer
Dim S
Application.ScreenUpdating = False
Lrr = Sheets("1").Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To Lrr
    For Each S In ThisWorkbook.Sheets
    M = S.Cells(Rows.Count, "A").End(xlUp).Row + 1
    If Left(Sheets("1").Cells(r, 1), 3) = S.Name Then
Sheets("1").Range("A" & r).Copy
 With S
.Range("A" & M).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 M = M + 1: End With
 End If
 Next
Next

End Sub

[وليد فتحي]

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

استاذنا الفاضل ابو حنبين

دائما مبدع بالاكواد

وعذرا لطول الكود بتاعي انت تعلم انني مازلت في بداية تعلم الاكواد منك ومن الاساتذة العظماء بالمنتدي

جزاك الله كل خير وزادك الله من علمه

لك كل تحيه وتقدير

[أبو حنــــين]

اخي وليد

انك في الطريق الصحيح ان شاء الله

و بداية الألف ميل تبدأ بخطوة وانت قطعت الكثير

بالتوفيق

جزاكم الله خيرا

[نينوص06]

الله يحفظ لك والديك

 

أخي

وليد فتحي

 

هذا ما أبحث عنه

[نينوص06]

أخي

أبو حنين

شكرا لك 

 

كود في منتهى الروعة