مطلوب مسح البيانات الملفات الفرعيه من خلال الملف الرئيسي

[خالـ(ابوعثمان)ـد]

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

الرجاء من الاخوه مساعدتي كما عهدتكم

والمشكله تتلخص في اني ربطت اكثر من ملف اكسل بلمف واحد رئيسي

ولكن المشكله اذا اردت مسح البيانات من الملفات يجب فتح كل الملفات لمسح هذه البيانات

والمطلوب اذا كان بالامكان من خلال الملف الرئيسي مسح البيانات الموجوده بالملفات الفرعيه

انظر المرفقات

test.zip

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

السلام عليكم

استخدم هذا الكود :

Option Explicit


Sub kh_MyFill_ClearContents()

Dim fs, f, f1, fc

Dim my_path

Dim zz As Integer


On Error Resume Next

my_path = ActiveWorkbook.Path & "\"


Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(my_path)

Set fc = f.Files

Application.ScreenUpdating = False

For Each f1 In fc

    If f1.Name = ActiveWorkbook.Name Then GoTo 1

    If InStr(f1.Name, ".xls") Then

        Workbooks.Open Filename:=my_path & f1.Name

        Sheets(1).Select

        Range("C4:D12").ClearContents

        Workbooks(f1.Name).Close True

    End If

1:

Next

Application.ScreenUpdating = True

2:

If Not Err.Number = 0 Then Err.Clear

    Set fs = Nothing

    Set f = Nothing

    Set fc = Nothing

On Error GoTo 0

End Sub

المرفق اكسل2003

test.rar

[قصي]

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

[خالـ(ابوعثمان)ـد]

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

هذا هو المطلوب

ولكن لدي سؤال اذا امكن وهو

ممكن شرح هذا الكود

واذا اردت ان اضيف ملفات كيف يكون الكود واين اعدل في الكود

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

السلام عليكم

واذا اردت ان اضيف ملفات كيف يكون الكود واين اعدل في الكود

الكود يقوم بمسح الخلايا المحددة في الكود في الورقة الاولى

في جميع ملفات الاكسل الموجودة في فايل الملف

ما عدى الملف الموجود فيه الكود

-------------------------------------------------

يعني يمكنك اضافة اي ملف وستجرى العملية عليه تلقائيا

-------------------------------------------------

في هذه الجزئية الموجودة في الكود

يحدد الورقة والخلايا المراد مسحها

Sheets(1).Select

        Range("C4:D12").ClearContents

------------------------------------

[خالـ(ابوعثمان)ـد]

الف مليون تريليون شكراً

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

استاذي الفاضل خبور خير

وصلت الفكره وهى المطلوبه

اكرر شكري وتقديري لك اخي الفاضل

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

السلام عليكم

الاخ / قصي

تم فصل اسئلتك في موضوع منفصل على الرابط

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