الترحيل من 3 ملفات اكسل مغلقة الى ملف اكسل مغلق

**مختار حسين محمود** · ديسمبر 29, 2014

السلام عليكم أساتذتى واخوانى بالمنتدى

تناولت فى موضوعى السابق طريقة نقل بيانات من ملف مغلق الى ملف مغلق أخر بطريقة تسمى ado

وهى اختصار للعبارة ActiveX Data Objects بدأ العمل بها فى مايكروسوفت 1996

تستخدم هذة الطريقة فى ترحيل ونقل البيانات بين الملفات

استخدمت هذه الطريقة فى جلب البيانات الى شيت رئيسى ثم ربطت الشيت الرئيسى بشيت آخر بلينك .

بعد ذلك قلت لنفسى لو عندى كود لادخال البيانات الى ملف مغلق يبقى الأمر 10/ 10

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

والتفاصيل هنا : http://www.officena.net/ib/index.php?showtopic=57798

والحمد لله تم استبدال اللينك بكود . وتركت لكم الملفات فى الرابط ده . مرة مستخدما اللينك ومرة الكود فى ادخال البيانات للملف المغلق .

و اليوم أقدم لكم كيفية جلب البيانات من 3 ملفات مغلقة دفعة واحدة وبضغطة زر واحدة

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

للأصدقاء من خارج المنتدى : على الميديا فاير من خلال الرابط التالى

http://www.mediafire.com/download/gidslzjdssb2jii/copy__data_from_a_closed_excel_file__&_paste_it_in_a_closed_excel_file_by_mokhtar_(__3_).rar

للأصدقاء فى المنتدى : تفضلوا الملفات فى المرفق التالى . أرجوا أن يفيدكم وتستمتعوا به تحياتى للجميع

copy data from 3 closed excel file & paste it in a closed excel file by mokhtar ( 3 ).rar

**بن علية حاجي** · ديسمبر 29, 2014

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

أخي الكريم مختار، عمل جميل جدا ومجهود كبير للتسهيل في عملية نقل بيانات من ملفات مغلقة إلى ملفات أخرى مغلقة... جازاك الله خيرا وبارك الله فيك وفي أهلك... وقد قمت بإضافة ملف جديد والتعديل على كودي Import و Export في ملف mokhtar ونجحت العملية... والسؤال هو هل يمكن الاستغناء عن مرور عملية الاستراد والتصدير بالملف mokhtar ؟ إذ أنه تصبح عندنا نسختين لنفس الملف mokhtar و mokhtar4 والفرق الوحيد بينهما هو وجود الأكواد في ملف mokhtar وقد قمنا بعملية النسخ واللصق مرتين مرة من الملفات الثلاثة الأولى إلى ملف mokhtar والثانية من ملف mokhtar إلى ملف mokhtar4...

المهم جعل الله كل أعمالك في ميزان حسناتك...

أخوك بن علية

**ابو تراب** · ديسمبر 30, 2014

جميل :fff: جميل يامختار :fff: ... استمرفي هذا الموضوع المهم

ال ADO اداة رهيبة لنقل الاكسل الى مستوى قواعد البيانات و الاستعلامات SQL

**مختار حسين محمود** · ديسمبر 30, 2014

السلام عليكم

أستاذى الفاضل بن عليه

كلمة حق أقولها ولا أنكرها لى الشرف أن أكون تلميذا لكم فأنت من أوائل الذين ساعدونى فى المنتدى

( ألا تذكر أنك عملت لى القائمة المنسدلة التى نظهر منها مادة دراسية ونخفى الباقى )

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

الأولى لو عندى ملف مغلق نستطيع أن نأتى بالبيانات دون فتحة .وهذا يمثل عملية النقل الأولى

الفكرة الثانية التى يمكن الاستفادة منها أنه لو عندنا ملف

نستطيع أن ندخل اليه بيانات دون الذهاب اليه ودون أن يشعر أى شخص بجوارك

بأنك أدخلت بيانات الى هذا الملف وهذا يمثل عملية النقل الثانيه .

كما أننا نستطيع أن نستفيد من الموضوع ككل فى امكانية النقل والترحيل من 3 ملفات دفعة واحدة

ويمكن أن نرحل بيانات من أى عدد من الملفات تريده بالتغيير فى الأكواد

بعد كده كان ممكن أعرض الموضوع على جزئين كل جزء فيه فكرة من الفكرتين لكنى آثرت الدمج لجذب الإنتباه

أظن حضرتك فهمتنى تقبل تحياتى .

****************************************************************************************************

الأستاذ أبو سليمان الموضوع زاد نورا بمررك

****************************************************************************************************

الأخ العزيز أبوتراب

أخى لقد قطعت على نفسى عهدا أن أقدم لكم كل جديد أتعلمه

بارك الله فيك وفى مرورك الكريم

تم تعديل أبريل 29, 2015 بواسطه دغيدى

ياسر خليل أبو البراء · ديسمبر 30, 2014

تسلم يا أخ الغالي مختار

موضوع في منتهى الروعة ..

لي عندك طلب ..ابدأ في شرح كل فكرة على حدة وبالتفصيل عشان الكل يقدر يستفيد من الموضوع بشكل كبير

منياوى · ديسمبر 30, 2014

شكراً الف شكر

**مختار حسين محمود** · ديسمبر 30, 2014

أولا أساتذتى واخوانى السلام عليكم ورحمة الله وبركاته

ثانيا بارك الله فييك اخى j011

ثالثا : أشكرك أستاذى الكريم ياسر خليل على مروك الكريم وتشجيعك لى

وتنفيذا لتوجيهاتك أقدم للزملاء شرحا مبسطا :

بعد ما نوحد ربنا ونصلى على المصطفى صللى الله عليه وسلم

الموضوع حضراتكم فيه ثلاث أفكار يمكن تطبيقها

1 - نسخ أو جلب أو ترحيل بيانات من ملف مغلق واحد

2 - نسخ أو جلب أو ترحيل بيانات من أى عدد من الملفات المغلقة .
3- - ادخال بيانات الى ملف مغلق ( بطريقة لا تشعر فيها بأنه تمت عملية نسخ الى هذا الملف تماما مثل البرامج التى تعمل فى الخلفيه دون شعور المستخدم )

1-الكود التالى نضعه فى حدث الـــــــ Workbook بتاع الملف المغلق اللى هننقل منه البيانات

Private Sub Workbook_BeforeClose(Cancel As Boolean)
         ActiveWorkbook.Save
            
           Application.Quit

End Sub

الكود يعمل على حفظ البيانات التى كتبناها فى الملف المغلق الذى نريد النقل منه كما أنه يغلق الاكسل بدون تدخل منك .

****************************************************************************************

الكودان التاليان نضع كلا منهما ا فى مديول عادى فى الملف اللى هنحط فيه البيانات التى أخذناها من الملف المغلق وهما معا أحد تطبيقات نظام ado فلى نقل البيانات
الكود الأول : نضعه كما هو بدون تتغيير :

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)

    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long

    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then

        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If

    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function Array_Sort(ArrayList As Variant) As Variant
    Dim aCnt As Integer, bCnt As Integer
    Dim tempStr As String

    For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
        For bCnt = aCnt + 1 To UBound(ArrayList)
            If ArrayList(aCnt) > ArrayList(bCnt) Then
                tempStr = ArrayList(bCnt)
                ArrayList(bCnt) = ArrayList(aCnt)
                ArrayList(aCnt) = tempStr
            End If
        Next bCnt
    Next aCnt
    Array_Sort = ArrayList
End Function

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

Sub GetData_Example1()

' السطر الاول بنقول للكود هات البيانات من  الملف المغلق الفلانى/ الشيت الفلانى
' السطر الذى يليه بنقول للكود انسخ المدى الفلانى من الشيت الفلانى 
'وكمان الصق الكلام ده فى الخليه الفلانيه

    GetData ThisWorkbook.Path & "\mokhtar1.xls", "Sheet1", _
            "A1:C5", Sheets("Sheet1").Range("AA1"), True, True
            
            
            ActiveWorkbook.Save
                                 Application.Quit
           
End Sub

ملحوظة مهمه فى الكود السابق :بص كده على الكلمتين دول True, True الكلمة الاخيرة تخلى الكود يظهر راس الصفحة ( لاحظ ذلك فى مرفق الموضوع )

أما لوكتبناهم بالشكل ده True, false رأس الصفحة مش هييجى ضمن البيانات التى أخدناها من الملف المغلق

ايضا لاحظ هنا أننا بنا خد البيانات بتاعتنا من ملف اكسل مغلق واحد وبكده نكون خلصنا الفكرة الأولى .

بعد ما خلصت الفكرة الاولى اخوانى شعرت بأنه لو يمكن ادخال البيانات الى ملف مغلق تبقى العمليه ايه !!!!!!!! ومن هنا ظهرت الفكرة الثانية

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

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

انظر الى الموضوع التالى : http://www.officena.net/ib/index.php?showtopic=57798

الكود ده غيرت فيه بحيت يفتح الملف ووتدخل البيانات بسرعة من غير ما حد يحس ان فيه حاجه حصلت وهذا هو الكود

Sub export_data()

    Dim mokhtar2 As Workbook
    Dim mokhtar3 As Workbook
     
    Application.ScreenUpdating = False
    
    Set mokhtar2 = ActiveWorkbook
   
    Set mokhtar3 = Workbooks.Open("C:/TEMP/mokhtar3.xls")
    
    mokhtar2.Sheets(1).Range("A1:C5").Copy
    
    With mokhtar3.Sheets(1).Range("A1")
        .PasteSpecial xlValues
        .PasteSpecial xlFormats
           End With
   
    Application.Quit
  
End Sub

الكود السابق نضعه فى مديول عادى فى الملف اللى هنرحل منه الى الملف المغلق اللى هو فى الأصل الملف اللى بستورد اليه البيانات من الملف المغلق ( الملف الرئيسى )
الكود معناه : بنصرح للبرنامج ان مختار 2 ومختار 3 دول اعتبرهم Workbook

ونشط لى مختار 2 وانسخ المدى a1 : c5 منه وطيران على المجلد temp اللى فى الــــ c هتلاقى هناك الملف المغلق مختار 3

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

ومتنساش تقفل الباب وراك يلا بسرعة كده ومن غير ما حد يحس بيك .
وبكه نكون خلصنا من الفكرة الثانيه .

************************************************************

الفكرة الثالثه : وليدة الفكرة الأولى الا انها تقوم على النسخ من عدد غير محدود من الملفات المغلقه ( 2 3 4 5 6 7 ........)
بعكس الفكرة الأولى التى ننسخ فيها بيانات من ملف مغلق واحد فقط
والكود التالى يمثل النقل من 3 ملفات مغلقة mokhtar1 mokhtar2 mokhtar3

Option Explicit

Sub GetData_Example3()

'السطران التاليان خاصان  بالنسخ من الملف المغلق مختار 1

'   True, True لاحظ فيهما الكلمتين

    GetData ThisWorkbook.Path & "\mokhtar1.xls", "Sheet1", _
            "A1:C12", Sheets("Sheet1").Range("A1"), True, True


 'السطران التاليان خاصان  بالنسخ من الملف المغلق مختار 2
       
   GetData ThisWorkbook.Path & "\mokhtar2.xls", "Sheet1", _
            "a2:c11", Sheets("Sheet1").Range("A13"), True, True
          
 'السطران التاليان خاصان  بالنسخ من الملف المغلق مختار 3
           
    GetData ThisWorkbook.Path & "\mokhtar3.xls", "Sheet1", _
            "E1:E23", Sheets("Sheet1").Range("E1"), True, True
                         
 'وبنفس الكيفية  يمكنك  زيادة عدد الملفات المغلقة         
                    
End Sub

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

تم تعديل ديسمبر 30, 2014 بواسطه مختار حسين محمود

**خيماوي كووول** · ديسمبر 31, 2014

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

**مختار حسين محمود** · ديسمبر 31, 2014

بارك الله فيك أخوى خيماوى نورت الموضوع بزيارتك

وليد زقزوق · يناير 10, 2015

رائع

ابو جودى · أبريل 29, 2015

رائع اخى مختار

فى المشاركة الثامنة

الكود قبل الاخير

كيف نغير اسم الملف مختار 3 بحيث يتم الترحيل لاى ملف اكسل مغلق داخل الفولدر

عذرا لا اجيد موضوع الاقتباس

**مختار حسين محمود** · أبريل 29, 2015

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

أخى عمرو اسم الملف واسم الشيت واسم المدى المنسوخ منه أو اليه لا يهم

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

تم تعديل أبريل 29, 2015 بواسطه مختار حسين محمود

ابو جودى · أبريل 29, 2015

استاذ مختار

اريد استبدال ملف مختار 3

بعدد كبير من الملفات

**مختار حسين محمود** · أبريل 29, 2015

معلش يا عمرو انشغلت شويه عنك

هل تقصد أنك تريد أن تنسخ بيانات من عدد كبير من الملفات المغلقة

         
    GetData ThisWorkbook.Path & "\mokhtar3.xls", "Sheet1", _
            "E1:E23", Sheets("Sheet1").Range("E1"), True, True
                         
 'وبنفس الكيفية  يمكنك  زيادة عدد الملفات المغلقة

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

غير اسم الملف واسم الشيت والمدى المنسوخ

تم تعديل أبريل 29, 2015 بواسطه مختار حسين محمود

**ا بو سليمان** · أبريل 29, 2015

اخي مختار بارك الله فيك

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

مع العلم ان البيانات التي في الجداول المتعدةه تتحدث

وسبق وكتبت موضوع بهذا الخصوص

**ا بو سليمان** · أبريل 29, 2015

http://www.officena.net/ib/index.php?showtopic=60533

ابو جودى · أبريل 29, 2015

عفوا استاذ مختار

ليس ذلك المطلوب

المطلوب نسخ بيانات من مختار 2

الى كل ملفات الاكسل داخل الفولدر

**مختار حسين محمود** · أبريل 29, 2015

أخى سليمان سوف أطلع على الرابط

أخى عمرو أكرمك الله

مختار 1 زى مختار 2 زى مختار 3 .....مختار 10000.الخ كلها ملفات مغلقة والسلام

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

أرجو أن تكون الفكرة وصلت

ابو تريكة · أبريل 30, 2015

بارك الله فيك

وجزاك عنا خيرا

اخي الكريم مختار تم تطبيق الكرد بصراحه ابداع

ولكن ظهرت لي مشكلة

ان اول صف من كل شيت من الشيتات المجمعه في الملف يكون بياناته مخربه

حتى بعد التعديل على الملفات الفرعية وتغيير القيم .. أيضا تظهر القيم بشكل غريب يعني اذا كانت يوجد في الصف الاول فقط خليتين من ضمن البيانات فارغتين يظهرو في التجميع في شكلل f9 & f8 & f5

وتكرر المشكلة في كل شبت

اما بافي الصفوف في كل شيت تمام

أرجو التوضيح

وشكرا لك

**مختار حسين محمود** · أبريل 30, 2015

لا أستطيع الرد الا اذا رأيت الملف لكن انظر الى الكود

Sub GetData_Example1()

' السطر الاول بنقول للكود هات البيانات من  الملف المغلق الفلانى/ الشيت الفلانى
' السطر الذى يليه بنقول للكود انسخ المدى الفلانى من الشيت الفلانى 
'وكمان الصق الكلام ده فى الخليه الفلانيه

    GetData ThisWorkbook.Path & "\mokhtar1.xls", "Sheet1", _
            "A1:C5", Sheets("Sheet1").Range("AA1"), True, True
            
            
            ActiveWorkbook.Save
                                 Application.Quit
           
End Sub

فى السطر ده "A1:C5", Sheets("Sheet1").Range("AA1"), True, True تحديدا

تأكد من الكلمتين True, True لو الثانية false غيرها الى True

**ا بو سليمان** · مايو 1, 2015

اخي مختار هل فيه امكانية للشرح من خلال مقطع مصور

**مختار حسين محمود** · مايو 1, 2015

لا أخى سليمان

ابو تريكة · مايو 3, 2015

السلام عليكم

اخي الكريم مختار

المشكله اللى ظهرت معايا في الملف الملف المرفق

وشكرا لحضرتك جدا

123.rar

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

**Yasser Fathi Albanna** · مايو 3, 2015

أخى الحبيب / مختار

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

إستمر

**مختار حسين محمود** · مايو 3, 2015

أخى الحبيب بوتريكة

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

كل اللى عملته حضرتك 10/ 10

الأخطاء الحمراء f1 f2 f3 f4 التى فى ملف التجميع سببه أن الخلايا فى الملف الأصلى فارغة

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

للعلم أن الدالات تحمل جدول من a1 : t26 كله كده على بعضه به بيانات أم لا لا يهم

تنقل البيانات الى ملف التجميع والخلايا الفارغة هتلاقى مكانها الافات دى .

جرب تعبئة الخلايا الفارغة فى الجدول بالملفات الثلاثة ستجد أنه لا شىء من هذا القبيل

تحياتى لك

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

تسجيل الدخول

الترحيل من 3 ملفات اكسل مغلقة الى ملف اكسل مغلق

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

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

Important Information