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

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


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

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

تحية وبعد

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

شرح الكود

يعمل على جلب البيانات من ملف رقمه في الخلية 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

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

السلام عليكم

أخي الكريم

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


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

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

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

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

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



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information