هل من طريقة لاستيراد بيانات من اكسيل الى اكسيل

[عصام2008]

الأخوة الأعزاء السلام عليكم ورحمة الله وبركاته

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

علما بان البيانات توجد في ورقة وعبارة عن بيانات في أكثر من 10 أعمدة

وجزاكم الله عني خيرا

مرفق مثال اريد المساعدة فيه

نقل البيانات من ورقة Statment في الملف 1 الى ورقة Statment في الملف 2

Data1-2.rar

[عبدالله باقشير]

السلام عليكم

هل ترغب في استيرادها بزر

في الملف 2

اذا اردتها عند فتح الملف 2

استخدم الكود التالي في حدث ThisWorkbook

Private Sub Workbook_Open()

Call kh_DateImport

End Sub

وهذا هو الكود :

Sub kh_DateImport()

Dim ib As Boolean

Dim MyAr

Dim MySh As Worksheet

Dim MyNBook As String, MyPath As String, rAd As String


On Error GoTo 1


Set MySh = ThisWorkbook.Sheets("Statment")

MySh.UsedRange.ClearContents

MyNBook = "ملف 1" & ".xls"

MyPath = ActiveWorkbook.Path & "\" & MyNBook

'---------------------------------------

' هل الملف مغلق

ib = Not Workbook_Open(MyNBook)

'---------------------------------------

Application.ScreenUpdating = False

' اذا الملف مغلق يقوم بفتحه

If ib Then Workbooks.Open MyPath

'---------------------------------------

With Workbooks(MyNBook).Sheets("Statment")

rAd = .Cells.CurrentRegion.Address

MyAr = .Range(rAd).Value

End With

'---------------------------------------

' اذا كان الملف مغلق سابقا يقوم باغلاقه

If ib Then Windows(MyNBook).Close

'---------------------------------------

MySh.Range(rAd).Value = MyAr

Application.ScreenUpdating = True

MsgBox "تم الاستيراد بنجاح"


1:

If Err Then

MsgBox "Err.Number : " & Err.Number

Err.Clear

End If


MyAr = Empty

Set MySh = Nothing

End Sub

'دالة لمعرفة ان كان الملف مفتوخ


Function Workbook_Open(WbookName As String) As Boolean

Dim wBookCheck As Workbook

Application.Volatile

On Error Resume Next

Set wBookCheck = Workbooks(WbookName)

Workbook_Open = Not wBookCheck Is Nothing

On Error GoTo 0

End Function

شاهد المرفق

Data1-2.rar

[عصام2008]

الأخ الفاضل وأستاذنا العظيم عبدالله باقشير

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

جعل الله هذا العمل في ميزان حسناتك انشاء الله

[عصام2008]

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

الأخ الفاضل عبدالله باقشير

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

هل من حل لهذا الموضوع

[عبدالله باقشير]

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

الأخ الفاضل عبدالله باقشير

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

هل من حل لهذا الموضوع

الحل هذا معمول للاستخدام في جهاز واحد

امور الشبكة هذه لا علم لي بها

تقبل اعتذاري

وتحياتي وشكري

[عصام2008]

الأخ الفاضل عبدالله باقشير

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

ولكن ما أو توضيحه هو تجربتي الفعلية واردت وضعها هنا للاستفادة انشاء الله

عند وضع الملفين في فولدر مشترك على شبكة كل منهما يعمل على جهاز مختلف يفضل اغلاق احد الملفين قبل التحديث حتى يعطي نتائج 100% أما اذا كان أحدهم مفتوح فلابد من القيام بحفظ العمل أولا في كلا الملفين قبل عملية التحديث هذا والله من وراء القصد

[عبدالله باقشير]

السلام عليكم

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

تقبل تحياتي وشكري

[عصام2008]

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

الأخ الفاضل استاذ عبدالله

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

وهي ورقة Buys بمعني اريد استيراد البيانات من ورقتي Stor ,Buys للملف الأخر

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

مرفق الملفين

Data1-2.rar

[عصام2008]

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

[عصام2008]

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

[عبدالله باقشير]

السلام عليكم

هذه الكود يستورد من ثلاثة اوراق

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

'  اسماء الاوراق التي تريد التعامل معهم

'  يمكنك اضافة اسم اي ورقة على شرط ان تكون موجودة في الملفين

'  هذا الكود يقوم بالاستيراد من ثلاث اوراق حسب الاسماء ادناه

Const nSheet As String = "Statment,Stor,Buys"

'   اسم الملف الذي تريد الاستيراد منه

Const nBook As String = "ملف 1" & ".xls"


Sub kh_DateImport1()

Dim ib As Boolean

Dim nSh

Dim wo As Workbook

Dim MyPath As String, rAd As String


On Error GoTo 1


Set wo = ThisWorkbook


For Each nSh In Split(nSheet, ",")

    wo.Worksheets(CStr(nSh)).UsedRange.ClearContents

Next


MyPath = ActiveWorkbook.Path & "\" & nBook

'---------------------------------------

'   هل الملف مغلق

ib = Not Workbook_Open(nBook)

'---------------------------------------

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

'   اذا الملف مغلق يقوم بفتحه

If ib Then Workbooks.Open MyPath

'---------------------------------------

For Each nSh In Split(nSheet, ",")

    Workbooks(nBook).Worksheets(CStr(nSh)).UsedRange.Copy

    wo.Worksheets(CStr(nSh)).Range("A1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False

Next

'---------------------------------------

'   اذا كان الملف مغلق سابقا يقوم باغلاقه

If ib Then Windows(nBook).Close

'---------------------------------------

1:

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

If Err Then

    MsgBox "Err.Number : " & Err.Number

    Err.Clear

    Else: MsgBox "تم الاستيراد بنجاح"

End If


Set wo = Nothing

End Sub

يمكك الاستغناء عن الكود السابق

الدالة ايضا تستخدم في هذا الكود

لا تقوم بحذفها

شاهد المرفق 2003

Data1-2.rar

[عصام2008]

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

[أحمد فؤاد]

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

والله أعمالك بتبهرنا ولا نستطيع التعليق ولا أعرف ماذا أقول

بارك الله فيك

[عابردرب]

أخي الفاضل جزاك خير الجزاء

سؤالي ؟ هل من طريقة لأستيراد بيانات اعمدة محددة من وراقه واحد إلى اعمدة أخرى في ورقة 2 مثال

استيراد عمود a-c f من ورقة 1 الي ورقة 2 في ورقه 2 تكون بيانات a من 1 في c من 2