ترحيل بيانات من ملف إلى آخر باستخدام الأكواد

[ياسر أحمد الشيخ]

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

اريد ترحيل بيانات لعدة ملفات فى الدليل

E:/excel work/daily plant report / septemper

والملفات اسمها daily plant report 1-9-2011

إلى نهاية الشهر 30/9

البيانات فى شيت production c85:c91

ارجو وضع حلين:

1- كود واحد شامل لترحيل بيانات من عدة ملفات موجودة فى دليل واحد يحتوي على (اسم الملف - الشيت- نطاق البيانات - قائمة باسماء الملفات)

2- كود بسيط لترحيل بيانات من ملف واحد (يحتوي على اسم الملف والشيت ونطاق البيانات ) ويتم تكراره لبقيه الملفات

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

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

هناك طلب آخير ليكتمل الملف :

اريد عمل 5 شيتات آخرى :

(sum-count-countif-sumif-countifs-average)

لنفس النطاق وكل شيت يحتوي على الطلبين السابقين 1-2

وهذا هو الملف المرفق

Production required.rar

[ياسر أحمد الشيخ]

ارجو أن يتم وضع زر لتنفيذ كل كود (طلب) على حدة

يعنى فى الشيت هناك نوعين من الكود(بناء على الطلبين) اذا هناك فى كل شيت زرين (زر لتنفيذ الكود الشامل - وآخر لتنفيذ الكود البسيط)

وشكرا

والله الموفق

[ياسر أحمد الشيخ]

اين الردود يا جماعة

ملحوظة:

هذا الموضوع قد اضفته سابقاً ولكن باستخدام المعادلات ولكننى لم أجد حل مناسب

فقررت عمل نفس الموضوع باستخدام الاكواد

لعل وعسى أجد حل لهذا الموضوع

وشكرا جزيلا

[ياسر أحمد الشيخ]

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

ازيكم يا جماعه

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

ولكن الان اريد تطبيق الموضوع باستخدام الاكواد

الطلب مرة ثانيه:

1-اريد استيراد بيانات من 30 ملف لها اسم واحد باستخدام كود يمكن أن اكتب به اسماء الملفات واسم الشيت والنطاق

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

الفولدر الذى به الملفات هو: E:/excelwork/daily plant report/september

والملفات باسم Daily plant report 1-9-2011

إلى نهايه الشهر

[ياسر أحمد الشيخ]

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

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

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

Merging a Range from All Workbooks in a Folder

الطلبين: 1- ارجو تطبيق الكود الموجود فى الرابط على موضوعى والشرح كيف اضع (اسم الفولدر واسماء الملفات والشيت والنطاق )بالكود

(التنفيذ بذر ماكرو)

2- ارجو تبسيط الكود لأقوم بتنفيذه على ملف واحد

مع فائق الشكر والتقدير لكل أعضاء المنتدى

[ياسر أحمد الشيخ]

يا جماعه اين الردود

اين الاخ عبدالله المجرب وأحمد زمان و يحياوي وبقيه الاخوة

هل الموضوع صعب

الكود موجود فى الرابط ولكننى لا أعرف كيف اعدل عليه لأطبق على ملفى

وشكرا

[ياسر أحمد الشيخ]

يا جماعه اين الردود

اين الاخ عبدالله المجرب وأحمد زمان و يحياوي وبقيه الاخوة

هل الموضوع صعب

الكود موجود فى الرابط ولكننى لا أعرف كيف اعدل عليه لأطبق على ملفى

وشكرا

[ياسر أحمد الشيخ]

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

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

Sub MergeAllWorkbooks()

    Dim MyPath As String, FilesInPath As String

    Dim MyFiles() As String

    Dim SourceRcount As Long, FNum As Long

    Dim mybook As Workbook, BaseWks As Worksheet

    Dim sourceRange As Range, destrange As Range

    Dim rnum As Long, CalcMode As Long

    ' Change this to the path\folder location of your files.

    MyPath = "C:\Users\Ron\test"

    ' Add a slash at the end of the path if needed.

    If Right(MyPath, 1) <> "\" Then

	    MyPath = MyPath & "\"

    End If

    ' If there are no Excel files in the folder, exit.

    FilesInPath = Dir(MyPath & "*.xl*")

    If FilesInPath = "" Then

	    MsgBox "No files found"

	    Exit Sub

    End If

    ' Fill the myFiles array with the list of Excel files

    ' in the search folder.

    FNum = 0

    Do While FilesInPath <> ""

	    FNum = FNum + 1

	    ReDim Preserve MyFiles(1 To FNum)

	    MyFiles(FNum) = FilesInPath

	    FilesInPath = Dir()

    Loop

    ' Set various application properties.

    With Application

	    CalcMode = .Calculation

	    .Calculation = xlCalculationManual

	    .ScreenUpdating = False

	    .EnableEvents = False

    End With

    ' Add a new workbook with one sheet.

    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    rnum = 1

    ' Loop through all files in the myFiles array.

    If FNum > 0 Then

	    For FNum = LBound(MyFiles) To UBound(MyFiles)

		    Set mybook = Nothing

		    On Error Resume Next

		    Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))

		    On Error GoTo 0

		    If Not mybook Is Nothing Then

			    On Error Resume Next

			    ' Change this range to fit your own needs.

			    With mybook.Worksheets(1)

				    Set sourceRange = .Range("A1:C1")

			    End With

			    If Err.Number > 0 Then

				    Err.Clear

				    Set sourceRange = Nothing

			    Else

				    ' If source range uses all columns then

				    ' skip this file.

				    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then

					    Set sourceRange = Nothing

				    End If

			    End If

			    On Error GoTo 0

			    If Not sourceRange Is Nothing Then

				    SourceRcount = sourceRange.Rows.Count

				    If rnum + SourceRcount >= BaseWks.Rows.Count Then

					    MsgBox "There are not enough rows in the target worksheet."

					    BaseWks.Columns.AutoFit

					    mybook.Close savechanges:=False

					    GoTo ExitTheSub

				    Else

					    ' Copy the file name in column A.

					    With sourceRange

						    BaseWks.Cells(rnum, "A"). _

								    Resize(.Rows.Count).Value = MyFiles(FNum)

					    End With

					    ' Set the destination range.

					    Set destrange = BaseWks.Range("B" & rnum)

					    ' Copy the values from the source range

					    ' to the destination range.

					    With sourceRange

						    Set destrange = destrange. _

										    Resize(.Rows.Count, .Columns.Count)

					    End With

					    destrange.Value = sourceRange.Value

					    rnum = rnum + SourceRcount

				    End If

			    End If

			    mybook.Close savechanges:=False

		    End If

	    Next FNum

	    BaseWks.Columns.AutoFit

    End If

ExitTheSub:

    ' Restore the application properties.

    With Application

	    .ScreenUpdating = True

	    .EnableEvents = True

	    .Calculation = CalcMode

    End With

End Sub

[الـعيدروس]

السلام عليكم

اخي الفاضل الله لايهينك

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

وشرح بسيط كي نقدر نساعدك

وطلبك ليس صعب امام قدرة العباقرة في هذا المنتدى العظيم

[ياسر أحمد الشيخ]

أخى : أنا لا اعرف إزاى أضع البيانات داخل الاكواد (فانا جديد فى مجال الأكواد)

فبرجاء أن تطبق عليه ولو بمثال صغير

[ياسر أحمد الشيخ]

اين الردود يا جماعه

[الـعيدروس]

ارفق مثال يااخي

اسماء الشيتات

مثلا

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

ملف اكسل ترحيل 1

ملف اكسل ترحيل 2

هذا مااقصده كي يتضح المطلوب اكثر

[ياسر أحمد الشيخ]

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

اريد ترحيل بيانات لعدة ملفات فى الدليل

E:/excel work/daily plant report / septemper

والملفات اسمها daily plant report 1-9-2011

إلى نهاية الشهر 30/9

البيانات فى شيت production c85:c91

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

وأرجو أيضا أن يتم عمل الشيتات التالية لنفس نطاق البيانات:

sum-count-sumif(>12000)-countif(->12000) average-if

وذلك بجانب شيت ترحيل البيانات دون اجراء أى عملية عليها

الملفات فى المرفقات

Daily plant report 01-09-2011.rar

ملف الترحيل.rar

[ياسر أحمد الشيخ]

اين الردود يا أخ alidroos

اذا كان هناك أى شئ غير واضح قوللى يا أستاذ alidroos

وشكرا جزيلا على الرد

[ياسر أحمد الشيخ]

اين الردود يا جماعه

أين الردود يا استاذ Alidroos

[ياسر أحمد الشيخ]

_{سأقوم بتجزئة سؤالى :}

_{1- اريد معرفة كيفية وضع سلسلة الملفات فى هذا الجزء من الكود}

_{الملفات باسم daily plant report 1/9/2011.xls}

_{إلى آخر الشهر}

' Fill the myFiles array with the list of Excel files

    ' in the search folder.

    FNum = 0

    Do While FilesInPath <> ""

		    FNum = FNum + 1

		    ReDim Preserve MyFiles(1 To FNum)

		    MyFiles(FNum) = FilesInPath

		    FilesInPath = Dir()