(تمت الاجابة) ترحيل تلقائي

[nash60]

يسم الله الرحمن الرحيم

المطلوب باختصار ترحيل عدة صفحات بعد تحديث بياناتها تلقائيا الى صفحة واحدة .

في المثال المرفق يوجد توضيح للمطلوب بتفصيل اكثر .

ولكم جزيل الشكر مقدما

UpDateMyData010.rar

[طارق محمود]

السلام عليكم

أخي العزيز

المطلوب غير منطقي لأن الورقات ليست بنفس الأعمدة فبعضها به متوسط مرجح والآخر لا ومعظم البيانات 10 أعمدة وبعضها 11 ويصل الحال إلي 41 عمود بيانات في بورصة فلسطين

تفضل حل وسط

أن تنتقل البيانات المحدثة إلي صفحاتها الرئيسية والتي تبدأ بـ To_ ولن نلغي تلك الصفحات الرئيسية

إستعمل هذا الكود

Sub Update_Total()

For i = 6 To 20 Step 2

    n = Sheets(i).Name

    sb_n = Right(n, Len(n) - 3)



    Sheets(i).Range("A1:BZ1000").ClearContents

    Range(Sheets(i - 1).[A2], Sheets(i - 1).Cells.SpecialCells(xlLastCell)).Copy (Sheets(i).[A1])

	    c = Sheets(i).[A1].End(xlToRight).Column

	    Lr = Sheets(i).[A1000].End(xlUp).Row

	 Range(Sheets(i).Cells(1, c + 1), Sheets(i).Cells(Lr, c + 1)) = sb_n



Next

End Sub

[nash60]

اخي العزيز الفاضل :

اشكرك جزيل الشكر على ردك علي وبناءا على رايك لا مانع من ابقاء الصفحات التي ذكرت ( To_ ) على ان يتم ترحيل هذه الصفحات بعد تحديثها بشكل متتالي الى

الصفحة ( All_Market ) كما ذكرت سابقا علما ان الكود الذي كتبته سابقا شكله انه بحاجة زر وانا اريد ان يتم الترحيل تلقائي واتمنى عليك ترفق التعديل بالملف

اسال اله العلى القدير ان يبارك فيك ويرحمك ويرحم والديك

[طارق محمود]

السلام عليكم

أي العزيز

غيرت قليلا في الكود ليناسب طلبك

Sub Update_Total()


With Sheets(4).Range("A1:BZ10000")

    .ClearContents

    .ClearFormats

End With


For i = 6 To 20 Step 2

    n = Sheets(i).Name

    sb_n = Right(n, Len(n) - 3)



    Sheets(i).Range("A1:BZ1000").ClearContents

    Range(Sheets(i - 1).[A1], Sheets(i - 1).Cells.SpecialCells(xlLastCell)).Copy (Sheets(i).[A1])

		    c = Sheets(i).[IV2].End(xlToLeft).Column

		    Lr = Sheets(i).[A1000].End(xlUp).Row

		 Range(Sheets(i).Cells(1, c + 1), Sheets(i).Cells(Lr, c + 1)) = sb_n

    Rw4 = Sheets(4).[A10000].End(xlUp).Row + 1

	   If Rw4 = 2 Then Rw4 = 0: GoTo 10

    Sheets(4).Rows(Rw4).Interior.ColorIndex = 4

10

    Range(Sheets(i).[A1], Sheets(i).Cells.SpecialCells(xlLastCell)).Copy (Sheets(4).Cells(Rw4 + 1, 1))


Next i

End Sub

مع اضافة الترحيل لصفحة (All_Market) ووضع خط أخضر بين بيانات الأسواق المختلفة في تلك الصفحة

تفضل المرفق

UpDateMyData010_1.rar

[طارق محمود]

السلام عليكم

أخي

لقد أوقفت التحديث بوضع أبوستروف قبل السطر في الكود الخاص بالورقة (Main)

Private Sub Up_Date_Click()

MsgBox "!!!الرجاء الانتظار بينما يتم الان تحديث بيانات التداول لسوق فلسطين المالي وبورصة عمان مباشرة من الانترنت ويستغرق ذلك عدة دقائق او اكثر حسب سرعة الاتصال لديك", vbInformation + vbMsgBoxRight, "تم الاستخراج"

    Application.ScreenUpdating = False

   ' ActiveWorkbook.RefreshAll



   Call Update_Total


    Application.ScreenUpdating = True


End Sub

كل ماعليك أن تزيل الأبوستروف من السطر

' ActiveWorkbook.RefreshAll

ليصبح

ActiveWorkbook.RefreshAll

[nash60]

اشكرك اخي جزيل الشكر وبارك الله فيك وان شاء الله في ميزان حسناتك

[nash60]

بسم الله الرحمن الرحيم

اعتذر مرة ثانية بسبب العودة للموضوع ولكن ذلك بسبب حاجتي الماسة له :

ما اريده هو بعد تحديث البيانات عبر الانترنت ان ترحل الخلية A1 الى اخر عمود بالصفحة ( Madket ) ولاخر صف فيه بيانات مثل العمود الاصفر

مرفق المثال

UpDateMyData010.rar

[طارق محمود]

السلام عليكم

أخي العزيز

تفضل المرفق

UpDateMyData010_2.rar

[nash60]

شكرا لك يا اخي الفاضل كثير الشكر وانا اسف لانني غلبتك معاي