طلب كود ترحيل نطاقات متغيرة كل 5 دقائق

[رضا راغب]

حياكم الله ومساكم بالخير

الطلب على النحو التالى

أريد ترحيل نطاقات متغيرة من ورقة الى ورقة  كل 5 دقائق

مثالا  يرحل النطاق الاول ثم الذى يليه بعد 5 دقائق

ثم النطاق الثانى ثم الثالث ثم الرابع ثم الخامس إلى أخره 

مع أمكانية إستدعاء الماكرو بواسطة أحد مفاتيح لوحة المفاتيح

رابط الموضوع الاصلى مشاركة 11  وكانت به إفادة عظيمة من المبدع 

أخى الاستاذ المبدع  / ياسر خليل " حفظه الله "

http://www.officena.net/ib/topic/59492-طلب-كود-ترحيل-بيانات-كل-5-دقائق/

يوجد ملف يوضح ذلك ودمتم بخيرولكم جزيل الشكر

Transfer Data Every 10 Seconds.rar

تم تعديل أكتوبر 22, 2015 بواسطه رضا راغب

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

أخي الكريم رضا

جرب الكود التالي عله يفي بالغرض

Sub TarhilRanges()
    Dim R As Range
    For Each R In Sheet1.Columns("A").SpecialCells(2, 1).Areas
        Application.Wait (Now + TimeValue("00:00:05"))
        R.CurrentRegion.Copy Sheets("Sheet2").Cells(R.Row, "C")
    Next R
    Application.CutCopyMode = False
    MsgBox "Done!", 64
End Sub

 

[رضا راغب]

اخى الكريم ياسر خليل

حياكم الله

كما تقولون بشرة خير

جربت اخى الكريم الكود ولكنه أتى بترحيل جميع النطاقات دفعه واحدة

ماأريد أخى هو ترحيل النطاق الاول ثم انتظار5 دقائق

ثم ترحيل النطاق الثانى ثم انتظار 5 دقائق

ثم ترحيل النطاق الثالث ثم انتظار 5 دقائق

وهكذا الى نهاية النطاقات مهما بلغ عدد النطاقات 

دمتم بخيرولكم جزيل الشكر

 

[رضا راغب]

حياكم الله

أخى الكريم ياسر خليل

وأسعد الله مساكم

والله ياأخى المنتدى ملىء بقدرعالى من الكفاءات والمعلومات القيمة 

بالبحث وجدت ملف للأخ الكريم عبدالله باقشير

وقد طوعت الملف للعمل عليه ليلائم طلبى هذا

ما أريده هون الترحيل من ورقة البيانات المرحلة الى ورقة ترحيل كل 5 دقائق

دمتم أخى الكريم بخيرولكم جزيل الشكر

الاسماء.rar

تم تعديل أكتوبر 23, 2015 بواسطه رضا راغب

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

أخي الكريم جرب الكود مرة أخرى (أنا جعلت فترة الانتظار 5 ثواني لتجربة الكود ليس إلا ..يمكنك تغيير فترة الانتظار من هذا السطر

Application.Wait (Now + TimeValue("00:00:05"))

 

[رضا راغب]

اخى الكريم ياسر جربت الكود مرة أخرى 

نفس الشغلة لايوجد فترات زمنية بين ترحيل النطاق والنطاق التالى

الكود ينفذ ترحيل النطاقات مرة واحدة 

دمتم بخيرولكم جزيل الشكر

تم تعديل أكتوبر 23, 2015 بواسطه رضا راغب

[أبو سجده]

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

أخى الفاضل الاستاذ //  رضا راغب

أهلا وسهلا بك أخى الكريم بين إخوانك المتميزين خلقا وعلما وأدبا

وبعد إذن اخى الحبيب // ياسر خليل " أبو البراء "

وإثراءا للموضوع إليك هذا الكود وبإذن الله تعالى ستجد حلا للموضوع

جزاكم الله خيرا وبارك فيكم

Private Const cRunWhat = "Tarhil_Values"
Private RunWhen As Double, Arr() As Range, CurIndex As Long

Public Sub StartTimer()
    Dim A As Areas, I As Long
    If RunWhen > 0 Then
        MsgBox "The Process Is Already Running"
        Exit Sub
    End If
    Set A = Sheets("Sheet1").Columns("A").SpecialCells(2, 1).Areas
    ReDim Arr(1 To A.Count)
    For I = 1 To A.Count
        Set Arr(I) = A(I).CurrentRegion
    Next I
    CurIndex = 0
    RunWhen = Now + TimeSerial(0, 0, 10)
    Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True
End Sub

Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=False
    RunWhen = -1
    MsgBox "Transferring Data Will Be Turned Off"
End Sub
Private Sub Tarhil_Values()
  CurIndex = CurIndex + 1
  If CurIndex > UBound(Arr) Then
     StopTimer
     Exit Sub
  End If
  Arr(CurIndex).Copy Sheets("Sheet2").Cells(Arr(CurIndex).Row, "C")
  Application.CutCopyMode = False
  RunWhen = Now + TimeSerial(0, 0, 10)
  Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True
End Sub

 

تم تعديل أكتوبر 24, 2015 بواسطه سعيد بيرم

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

بارك الله فيك أخي وحبيبي في الله سعيد بيرم

كود رائع بحق ..تسلم الأيادي

إليك أخي الكريم رضا راغب الملف المرفق فيه تطبيق كود أخونا الحبيب سعيد بيرم

يتم الترحيل حسب الكود المرفق في الملف كل 5 ثواني (للتجربة فقط ..يمكنك تغيير الوقت المطلوب من الكود)

 

Transfer Data Every 5 Seconds.rar

[أبو سجده]

حبيب قلبى وأخى فى الله 

الاستاذ القدير // ياسر خليل " ابو البراء "  

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

تسلم من كل شر وياريت متحرمناش من مساهماتك

التى أخبرتك بها سالفا  دون رد 

اعانكم الله تعالى ورزقنا واياكم من حيث لانحتسب

جزاكم الله خيرا وبارك فى البراء

 

تم تعديل أكتوبر 23, 2015 بواسطه سعيد بيرم

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

أخي وحبيبي في الله سعيد

تأكد اني لا أبخل بمعلومة ولا بوقت ولا بجهد أبداً لأي شخص في المنتدى

لو لدي علم بالأمر لتقدمت بدون أن تطلب في الحال ..ربما يكون تناول الموضوع يحتاج لوقت طويل

فالأفضل في تلك الحالة أن تقوم بتجزئة الموضوع إلى طلب صغير في كل موضوع ليسهل تقديم المساعدة من الجميع إذ أنه من يطارد عصفورين يفقدهما

فما بالك وأنت تريد مطاردة العصافير كلها مرة واحد

إن شاء الله ابدأ الموضوع من جديد وليكن طرحك للموضوع لطلب واحد فقط وحتى لو كان الأمر صعباً (بس يكون واضح ومفهوم) سنجد الحل بإذن الله (بالبحث والاستفسار ..)

تقبل وافر تقديري واحترامي

[رضا راغب]

حياكم الله وصبحكم بالخير

والله شيىء أكثر من رائع

لا أتوقع أن ينتهى هذا الموضوع بهذة الحرفية العاليه وبهذه السرعة

شكرا لك أخى أستاذى القدير / أسامة خليل 

وشكر خاص لأخى الاستاذ القدير / سعيد بيرم

صاحب هذة اللمسة العبقرية  

والله ما قصرتم معى ودمتم بكل خير وشكرا جزيلا 

 

[أبو سجده]

وحياكم الله تعالى أخى الكريم رضا راغب

لاتتردد فى أى طلب طالما أنه فى المستطاع

وان لم يكن فجميع السادة الزملاء هنا يتمتعون بما من الله عليهم من علمه

جزاكم الله خيرا وبارك الله فيكم

تم تعديل أكتوبر 24, 2015 بواسطه سعيد بيرم

[أبو سجده]

أخى وحبيب قلبى ابو البراء " حفظك الله "

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

أدرك انك لا تبخل على جميع السادة الاعضاء بما هو انت أهلا له

أخى ابو البراء سأعيد رفع الموضوع مرة أخرى بحول الله تعالى

ولكن بعد إستقرار حالتى الصحية حيث أحدثكم وأنا ملازم الفراش

دعواتكم لى بالشفاء وجزاكم الله خيرا 

تم تعديل أكتوبر 24, 2015 بواسطه سعيد بيرم

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

أخي وحبيبي في الله سعيد بيرم

أسأل الله العظيم رب العرش العظيم أن يشفيك

لا بأس طهور إن شاء الله