رجاء كود ترحيل لعدة صفحات

[محمود م ن]

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

احبتي الإعزاء :-
الرجاء كود ترحيل لعدة صفحات حسب كل عميل, مرفق ملف

شكرا لمجهودكم وتعاونكم 

بيانات1.rar

[رجب جاويش]

السلام عليكم

تفضل أخى محمود

Sub ragab()
Dim x As Integer
Dim T  As Variant
Dim Rng As Range
Dim S_name As Range
'=============================================================
For Each T In Array("عام", "خاص", "مغلق", "مفتوح")
On Error Resume Next
With Sheets(T)
Set Rng = .Range("B6:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set S_name = .Columns(2).Find(What:=[d5], LookAt:=xlWhole)
x = Application.WorksheetFunction.Match(T, [c8:c11], 0) + 7
.Cells(S_name.Row, 3) = Cells(x, 4)
End With
Next
End Sub

 

بيانات1.rar

[محمود م ن]

شكرًا لك أخي الكريم ,,, والله ما قصرت

[رجب جاويش]

جزاك الله خيرا أخى محمود

الحمد لله أن تم المطلوب

 

[خالد الرشيدى]

السلام عليكم

استاذى / رجب جاويس

جزاك الله خيراً .. كود رائع .. وارجو من حضرتك ايضاح ما فائدة هذا الجزء من الكود ..

Set Rng = .Range("B6:B" & Cells(Rows.Count, "B").End(xlUp).Row)

فلم يستخدم فى سطر الترحيل

.Cells(S_name.Row, 3) = Cells(x, 4)

تقبل فائق احترامى

[رجب جاويش]

أخى الفاضل / خالد الرشيدى

عندك حق يظهر إن الزهايمر اشتغل تانى

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

ربنا يستر على الذاكره

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

 

ودا الشكل النهائى للكود بعد حذف السطر

Sub ragab()
Dim x As Integer
Dim T  As Variant
Dim S_name As Range
'=============================================================
For Each T In Array("عام", "خاص", "مغلق", "مفتوح")
On Error Resume Next
With Sheets(T)
Set S_name = .Columns(2).Find(What:=[d5], LookAt:=xlWhole)
x = Application.WorksheetFunction.Match(T, [c8:c11], 0) + 7
.Cells(S_name.Row, 3) = Cells(x, 4)
End With
Next
End Sub

 

[خالد الرشيدى]

جزاكم الله خير استاذنا القدير/ رجب جاويش

على صدركم الرحب وأخلاقكم الرائعة 

أم التعديل أمر عادي ربما مجرد سهو منكم وإلا فأنتم أجدر بما هو أكبر من ذلك

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

[رجب جاويش]

أخى الفاضل / خالد الرشيدى

جزاك الله خيرا على هذا الأسلوب الراقى والكلمات الطيبة

تقبل أرق تحياتى وتقديرى لشخصكم الكريم

 

 

[ياسر خليل أبو البراء]

بارك الله فيك أخي وحبيبي الغالي رجب جاويش على أكوادك الرائعة

ومرحباً بعودتك كمشرف في المنتدى

تقبل تحياتي

 

[رجب جاويش]

شكرا جزيلا أخى الحبيب ياسر خليل

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

 

[محمود م ن]

بوركتم جميعا ,,, كم اعشق هذا المنتدى 

لي لديكم رجاء آخر 

اريد كود رسالة تأكيد تفيد هل أنت متأكد من تنفيذ الأمر ,, فإذا كان نعم يكمل تنفيذ الكود وإذا كان لا يتم إلغاء الأمر

اعذروني أن كنت أثقلت عليكم..

[ياسر خليل أبو البراء]

أخي الكريم محمود م ن

يرجى تغيير الـ م ن في لقبك بلقبك الحقيقي ليعبر عن شخصكم الكريم

جرب التعديل البسيط جداً في الكود الرائع لأخونا الغالي رجب

Sub Ragab()
    Dim X As Integer
    Dim T  As Variant
    Dim S_Name As Range
    
    If MsgBox("هل تريد تنفيذ الأمر؟", vbYesNo) = vbYes Then
        For Each T In Array("عام", "خاص", "مغلق", "مفتوح")
            On Error Resume Next
            With Sheets(T)
                Set S_Name = .Columns(2).Find(What:=[D5], LookAt:=xlWhole)
                X = Application.WorksheetFunction.Match(T, [C8:C11], 0) + 7
                .Cells(S_Name.Row, 3) = Cells(X, 4)
            End With
        Next T
    Else
        MsgBox "لم يتم تنفيذ الأمر .. تم إلغاء العملية", 64
    End If
End Sub

تقبل تحياتي

[رجب جاويش]

بارك الله فيك أخى الحبيب ياسر خليل