اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

السلام عليكم

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

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

  • Like 2
رابط هذا التعليق
شارك

السلام عليكم

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

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

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

 

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

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

 

  • Like 3
رابط هذا التعليق
شارك

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

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

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

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

  • Like 2
رابط هذا التعليق
شارك

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

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

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

 

 

  • Like 3
رابط هذا التعليق
شارك

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

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

تقبل تحياتي

 

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

تقبل تحياتي

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
×
×
  • اضف...

Important Information