تغيير اسم الشركة فى عدة ملفات مغلقة

[ابو جودى]

السلام عليكم

السادة الخيراء و الاعضاء

بعد التحية

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

و التى تصل الى 1500 ملف موزعة فى اكثر من فولدر فرعى و جميعها داخل فولدر واحد

فهل يمكن ذلك حسب المرفق التالى :

 

[ياسر خليل أبو البراء]

النموذج المرفق غير معبر عن طلبك على الإطلاق

ولم تحدد ما نوع التغيير الذي ترغبه ..ما هو التغيير المطلوب ؟

وهل التغيير يكون في كل المصنفات في كل أوراق العمل ؟؟

 

يرجى إعادة طرح طلبك بشكل أفضل

[ابو جودى]

استاذ ياسر خليل

شكرا لاهتمامك

و المطلوب بسيط جداً

و هو استبدال اسم الشركة القديم " شركة حياة للطاقة و المياة"

بالاسم الجديد " شركة حياة لخدمات المياه"

فى كل ملف اكسل [ فى كل ورقة داخل الملف مكتوب بها اسم الشركة ] 

[ياسر خليل أبو البراء]

أخي الفاضل عمرو

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

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

وأين هو الملف الرئيسي الذي من خلاله ستقوم بتغيير اسم الشركة في كل الملفات؟

[ابو جودى]

الاسم  ثابت فى خلية محددة

نعم يوجد اوراق ليس بها اسم الشركة

التعامل مع شرط وجود الاسم

لا يوجد ملف رئيسى فقط المطلوب استبدال الاسم القديم بالجديد

[مختار حسين محمود]

السلام عليكم

بعد اذن أخى وأستاذى ياسر

جرب المرفق  يا عمروووووووو

أولا  المجلد  فى الــــ  D   حسب الكود  يمكنك تغيير المسار

الملف  insert data in closed file  اضغط الزر فقط

كرر التجربة بس امسح اسم الشركة  من ورقة فواتير فقط

insert data in closed file.rar

[ابو جودى]

استاذ / مختار

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

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

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

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

و عليه فما الفائدة من الكود

ففى هذه الحالة الاسهل تعديل اسم الشركة مباشرة ملف ملف

و شكراً.

[ياسر خليل أبو البراء]

الأخ الفاضل عمرو طلبة

إليك الملف التالي عله يفي بالغرض

Sub LoopThroughAllWorkbooks()
    Dim FolderPath As String, FileName As String
    Dim WBK As Workbook
    Dim SH As Worksheet
    
    FolderPath = ThisWorkbook.Path & "\Collections\"
    FileName = Dir(FolderPath & "*.xl*")
    Application.ScreenUpdating = False
        Do While FileName <> ""
            Set WBK = Workbooks.Open(FolderPath & FileName)
            For Each SH In WBK.Worksheets
                If Not IsEmpty(SH.Range("A1")) And SH.Range("A1").Value = "شركة حياة للطاقة و المياه" Then
                    SH.Range("A1").Value = "شركة حياة لخدمات المياه"
                End If
            Next SH
            WBK.Close SaveChanges:=True
            FileName = Dir()
        Loop
        Range("A1").Select
    Application.ScreenUpdating = True
End Sub

أرجو أن يفي بالغرض

Loop Through All Workbooks To Change String.rar

[مختار حسين محمود]

عفوا يا عمرو  ماكنتش واخد بالى من الـــ 1500  ملف دى

كنت فاكر أنهم 3 عشان كده عملت الكود بالشكل ده  وربطت الشيتات ببعض

على العموم تحياتى وان شاء الله  تجد الحل

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

[ابو جودى]

أخى الكريم جدااااااا  / ياسر خليل أبو البراء

فعلاً هو المطلوب

دائماً مبدع

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

[ياسر خليل أبو البراء]

أخي الكريم عمرو طلبة

الحمد لله الذي بنعمته تتم الصالحات

والحمد لله أن تم المطلوب على خير ..

 

ومشكور على انهاء الموضوع بالشكل المناسب     

تقبل تحياتي

[مختار حسين محمود]

أستاذ ى و أخى ياسر 

 

وأنا أيضاُ توصلت للحل أحب أن أشاركم  به    ضع الكود التالى فى ملف 

Option Explicit

Sub export_data()

    'تعريف المتغير من النوع نصي
     Dim Path As String
 
     'تعريف المتغير من النوع نصي
     Dim Filename As String
     
     Dim Amro As Workbook
    
     Set Amro = ThisWorkbook
   
     'تعيين المتغير ليساوي مسار المجلد الذي يحوي المصنفات المراد دمج أوراق العمل منها
     Path = ThisWorkbook.Path & "\OUTPUT\"
     
     'تعيين المتغير ليساوي اسم كل مصنف من المصنفات التي سيتم التعامل معها
     Filename = Dir(Path & "*.xls")
     
     'إلغاء خاصية اهتزاز الشاشة
     Application.ScreenUpdating = False
     'إلغاء خاصية التنبيه بالرسائل
     Application.DisplayAlerts = False
     
     'حلقة تكرارية للمصنفات الموجودة في المسار المحدد إلى أن لا يجد أي مصنف بالمسار
      Do While Filename <> ""
     
     'فتح المصنف
      Workbooks.Open Filename:=Path & Filename
     
     'نسخ ولصق البيانات
      Amro.Sheets(1).Range("A1:a2").Copy
      
      ActiveWorkbook.Sheets.Select
   
      Range("A1").Activate
      ActiveSheet.Paste
           
      Application.CutCopyMode = False
     
     'حفظ وغلق الملفات
    
      Workbooks(Filename).Save
      Workbooks(Filename).Close
   
     'إعادة ضبط المتغير
      Filename = Dir()
      Loop
     
      'تفعيل خاصية التنبيه بالرسائل
      Application.DisplayAlerts = True
     
     'تفعيل خاصية اهتزاز الشاشة
     'Application.ScreenUpdating = True
     
End Sub

ياعمرو    ضع الــــ  1500  ملف فى    مجلد   باسم     OUTPUT    جنب ملف

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

 

تحياتى

[ابو جودى]

ياعمرو    ضع الــــ  1500  ملف فى    مجلد   باسم     OUTPUT    جنب ملف

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

 

تحياتى

أخيرا يا استاذ مختار

شكرا على مجهودك 

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

[مختار حسين محمود]

ياعمرو    ضع الــــ  1500  ملف فى    مجلد   باسم     OUTPUT    جنب ملف

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

 

تحياتى

أخيرا يا استاذ مختار

شكرا على مجهودك 

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

 

 

ماذا تقصد بأخيراً  يا عمرو :       أخيراُ              ولا   أخيـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــراً   ؟!