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

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

قام بنشر

السلام عليكم

اخواني الكرام .. لدي العديد من الملفات واريد نسخ جميع الخلايا الى ملف واحد ( مع الحفاظ على الكومنت الذي بداخلها )

الملف الاول AAA

الملف الثاني

AAA (2)

الملف الثالث

AAA (3) وهكذا

اريد دمجها لتصبح في ملف واحد

شكرا

قام بنشر

جرب الكود التالي (للملفات التي تبدأ الرقم 30) ، ونفس الكود مع الملفات التي تبدأ بـ 40 (التغيير في الرقم فقط)

Sub LoopClosedWBs()
    Dim strPath     As String
    Dim strFile     As String
    Dim wbk         As Workbook
    Dim wsh         As Worksheet
    Dim col         As Long
    
    Application.ScreenUpdating = False
        ActiveSheet.Cells.Clear
        strPath = ThisWorkbook.Path & "\Data\"
        strFile = Dir(strPath & "30*.xls*")
        col = 1
        
        Do While strFile <> ""
            Set wbk = Workbooks.Open(strPath & strFile)
            Set wsh = wbk.Worksheets(1)
            
            wsh.Range("A1:A2").Copy ThisWorkbook.Sheets(1).Cells(1, col)
            col = col + 1
            
            wbk.Close SaveChanges:=False
            strFile = Dir
        Loop
    Application.ScreenUpdating = True
End Sub

يمكن أن يظهر معك خطأ بسبب أسماء بعض الملفات (30 WithNewWord و 30 WithWord) حيث حرف الـ i خطأ ويتسبب في ظهور خطأ فقم إصلاح أسماء الملفات قبل تنفيذ الكود

الكود لن ينسخ البيانات بنفس الترتيب الذي أرفقته ، وإذا أردت أن يرتب بنفس الترتيب قم بإعطاء أرقام متسلسلة للملفات بعد الرقم 30 مثلاً  30_001 و 30_002 وهكذا

تقبل تحياتي

  • Like 1
قام بنشر

تمام استاذي العزيز


لكن بعض الملفات تحوي اكثر من عامود واحد

هل يمكن جعل Col مساوية لاخر Col مضاف اليها 1

شكرا

قام بنشر

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

حاول تطلع على الموضوع التالي لربما يفيدك وهو كيفية إيجاد رقم آخر عمود 

الرابط من هنا

قام بنشر

بصراحة حاولت و لم انجح بتصحيحعا

فضلا لا امرا .. هلا تفضلت بالتعديل عليها

و ان امكن جعل النطاق واسع لاكثر من ملف

كان نقول الملف الاول 30 الثاني 50 ... و يقوم بخفظها تلقائيا

قام بنشر

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

تقبل اعتذاري

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information