اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  • أفضل إجابة
قام بنشر

عندي ملف رئيسي واربع ملفات فرعيه وارغب بدمج الملفات الفرعيه بالرئيسي يعني أستجلاب البيانات من الفرعي للرئيسي وشكرا

انتبه من فضلك مشاركة مكررة ... تـــم بالفعل حذف المشاركة الأخرى

تم تعديل وتغيير عنوان المشاركة ليعبر عن طلبك

أسيوط.xls الاقصر.xls الملف المرفق.xls سوهاج.xls قنا.xls

قام بنشر

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

برنامج دمج ملفات الإكسيل فى ملف واحد Excel Merger

أو يمكنك استخدام هذا الكود

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
     fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
     If (vbBoolean <> VarType(fnameList)) Then
         If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
             Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
             Set wbkCurBook = ActiveWorkbook
             For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
                 Set wbkSrcBook = Workbooks.Open(FileName:=fnameCurFile)
                 For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
                 wbkSrcBook.Close SaveChanges:=False
             Next
             Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
             MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
     Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

 

  • Like 3
زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

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

Important Information