اختصار كود لجلب البيانات بحيث يتم تنفيذ نفس المضمون

[ابو تميم]

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

تحية وبعد

الكود التالي يعمل على جلب بيانات من ملف إلى جدول في ملف آخر وهو يعمل بشكل جيد لكنه طويل بعض الشيء ( وذلك لجهلي في الأكواد ولأني جديد على ذلك ولا زلت أتعلم )

شرح الكود

يعمل على جلب البيانات من ملف رقمه في الخلية F2 بحيث أن هذا الرقم يتغير بتغير الملف المراد جلب بياناته ويقوم الكود بالتوجه إلى هذا الملف ذو الرقم حسب المسار المحدد ويقوم بجلب البيانات منه إلى ملف العمل بحيث يتم جلب جميع الجدول ابتداء من الخلية A12 وحتى الخلية F12 وبعد ذلك يقوم بتجاهل الخلايا من G12 - J12 ويجلب بعدها الخلية K12 ويقوم بنسخها في ملف العمل كما هو موضح في الكود

طبعا الكود مطبق على الخلايا من السطر A12 ولغاية السطر A49 كما غي الكود

Private Sub CommandButton1_Click()


[A12:F12] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$16:$F$16"

[A13:F13] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$17:$F$17"

[A14:F14] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$18:$F$18"

[A15:F15] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$19:$F$19"

[A16:F16] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$20:$F$20"

[A17:F17] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$21:$F$21"

[A18:F18] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$22:$F$22"

[A19:F19] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$23:$F$23"

[A20:F20] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$24:$F$24"

[A21:F21] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$25:$F$25"

[A22:F22] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$26:$F$26"

[A23:F23] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$27:$F$27"

[A24:F24] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$28:$F$28"

[A25:F25] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$29:$F$29"

[A26:F26] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$30:$F$30"

[A27:F27] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$31:$F$31"

[A28:F28] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$32:$F$32"

[A29:F29] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$33:$F$33"

[A30:F30] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$34:$F$34"

[A31:F31] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$35:$F$35"

[A32:F32] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$36:$F$36"

[A33:F33] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$37:$F$37"

[A34:F34] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$38:$F$38"

[A35:F35] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$39:$F$39"

[A36:F36] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$40:$F$40"

[A37:F37] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$41:$F$41"

[A38:F38] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$42:$F$42"

[A39:F39] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$43:$F$43"

[A40:F40] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$44:$F$44"

[A41:F41] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$45:$F$45"

[A42:F42] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$46:$F$46"

[A43:F43] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$47:$F$47"

[A44:F44] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$48:$F$48"

[A45:F45] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$49:$F$49"


[H12] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$16"

[H13] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$17"

[H14] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$18"

[H15] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$19"

[H16] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$20"

[H17] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$21"

[H18] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$22"

[H19] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$23"

[H20] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$24"

[H21] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$25"

[H22] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$26"

[H23] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$27"

[H24] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$28"

[H25] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$29"

[H26] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$30"

[H27] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$31"

[H28] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$32"

[H29] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$33"

[H30] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$34"

[H31] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$35"

[H32] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$36"

[H33] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$37"

[H34] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$38"

[H35] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$39"

[H36] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$40"

[H37] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$41"

[H38] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$42"

[H39] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$43"

[H40] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$44"

[H41] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$45"

[H42] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$46"

[H43] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$47"

[H44] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$48"

[H45] = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$49"

End Sub

[ابو تميم]

up

[طارق محمود]

السلام عليكم

أخي الكريم

جرب الإختصار التالي

Private Sub CommandButton1_Click()

For i = 12 To 45

Range("A" & i & ":F" & i) = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$A$" & i + 4 & ":$F$" & i + 4

Cells(i, "H") = "='D:\CCV_MOJ\data\[" & [F2] & ".xlsb]" & [F2] & "'!$K$" & i + 4

Next i

End Sub

لم أجربه لأن الملف ليس لدي ولكن إن شاء الله سينجح

[دغيدى]

أخى الكريم / أبو تميم

كل عام وانتم بخير

ضع ملفا حتى يتمكن للكل مشاركتكم الحل

[ابو تميم]

الاستاذ طارق محمود

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

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

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

MoveData.rar

[بيسان]

السلام عليكم ...

هل يمكن تزويدنا بكود لحذف البيانات المضافة دفعة واحدة؟؟

مع امكانية عمل زر للاضافة والحذف في نفس الشيت

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

سمية الامير

[طارق محمود]

السلام عليكم

الأخت الفاضلة

الأفضل ان ترفقي ملفا به طلباتك

والأحسن ان تبدأي موضوع جديد لأن الطلب بعيد نسبيا عن هذا الموضوع