ربط البيانات بين مجلدين مختلفين

[ماجدجلال]

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

الكود التالي :

Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("البرج(1)").Cells(5, 50).Value

يقوم بنقل البيان او القيمة من صفحة الي صفحة اخري في نفس المجلد ,

ولكن السؤال : ماذا لو اردت نقل الصفحة الثانية الي مجلد منفصل ؟

يعني ما هو التعديل الذي يطرا علي الصيغة السابقة حتي تكون كل صفحة في مجلد منفصلة عن الصفحة الثانية ,,

وشكرا للجميع ,

[ماجدجلال]

للرفع

[ماجدجلال]

للرفع

[ramez]

جرب اللصق الخاص واختيار "لصق ارتباط " ..

[ماجدجلال]

شكرا لك اخي العزيز

جربت الطريقة ولم تنجح , واعتقد ان طريقة الكود هي افضل وانسب ,

شكرا لك , وفي انتظار رد احد المميزين او المشرفين ,,,

[ماجدجلال]

للرفع

[فلسطيني]

Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("البرج(1)").Cells(5, 50).Value

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

("البرج(1)").

و أتمنى أن تجد الحل بذلك

[ماجدجلال]

وكيف استطيع كتابة المسار ؟

ارجو المساعدة , اخي الله يوفقك الموضوع مطروح من فترة طويلة ولم اجد المساعدة ,,

ارجوك

[هادى محمد المامون سالم]

كانت عندى نفس المشكله

جرب الكود التالى مع تغيير الاسماء التى تريدها

Example If the Database sheet is in another workbook

This Example will do the same as the first example on this webpage

Only the database sheet is in another workbook.

The macro will open the database workbook if it is not open (It use the function to check if the workbook is already open)

The data will be paste as values in the first worksheet of the file "c:\test.xls"

Sub copy_to_another_workbook()

Dim sourceRange As Range

Dim destrange As Range

Dim destWB As Workbook

Dim Lr As Long

Application.ScreenUpdating = False

If bIsBookOpen("test.xls") Then

Set destWB = Workbooks("test.xls")

Else

Set destWB = Workbooks.Open("c:\test.xls")

End If

Lr = LastRow(destWB.Worksheets("Sheet1")) + 1

Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")

Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)

sourceRange.Copy

destrange.PasteSpecial xlPasteValues, , False, False

Application.CutCopyMode = False

destWB.Close True

Application.ScreenUpdating = True

End Sub

Copy this function together with the LastRow function in the module

Function bIsBookOpen(ByRef szBookName As String) As Boolean

' Rob Bovey

On Error Resume Next

bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)

End Function

[ماجدجلال]

شكرا جزيلا لك اخي علي المساعدة ,

ولي سؤال : ماهي اسماء الملفات التي قمت برابطهما في الكود السابق ؟

اعتقد ان الملف الاول كان اسمة ( test ) . هل هذا صحيح .

وما هو اسم الملف الثاني ,

وشكرا لك اخي مرة اخري ,,, وارجو المساعدة

[هادى محمد المامون سالم]

الملف الاول هو الذى تضع فيه الموديول السابق و تستطيع ات تسميه اى اسم , اما الملف الثانى اسمه فعلا Test .