هام هام ارجوكم .. كيفية مشاركة خلية بين صفحتين إكسيل

[SCHENGEN]

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

انا عندي مشكلة مواجهاني مش لاقيلها أي حل

أنا عندي ملف إكسيل فيه اكتر من Sheet

انا عامل الخلية A1 في كل شيت عبارة عن قائمة فيها اختيارات

انا عايز لما اغير A1 في شيت يتغير برضه في التاني والعكس ..

بمعني ان الخليتين لو غيرت في اي واحده يخلي التانيه زيها

يعني يخلي الخلية مشتركة بين الشيتين

------

مثال: SHEET 1: A1> AHMED

يخلي لوحدة SHEET 2: A1>AHMED

ولو غيرت SHEET2: A1>ZAKARIA

يغير لوحدة تاني SHEET 1: A1>ZAKARIA

وشكرا

[دغيدى]

الأخ الفاضل

هل هذا ما تقصده؟

المصنف1.rar

[SCHENGEN]

أولا شكرا علي ردك

للأسف ليس هذا ما أقصدة

بكل بساطه : اريد ان يكون هناك خليتين .. لما اغير واحدة التانيه تبقي زيها .. ولما اغير التانيه الاولي تبقي زيها

يعني : A1 > AHMED

الاقي اتغيرت A2 بقت AHMED

ولما اغير A2 اخليها ZAKARIA الاقي A1 اتغيرت من AHMED الي ZAKARIA

[عبد الفتاح كيرة]

الكود

فى الصفحة الأولى

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Not Intersect(Target, Range("a1")) Is Nothing Then

    Sheets(2).Range("a1") = Sheets(1).Range("a1")

End If

End Sub

و فى الصفحة الثانية

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Not Intersect(Target, Range("a1")) Is Nothing Then

    Sheets(1).Range("a1") = Sheets(2).Range("a1")

End If

End Sub

المرفقات

conect-kemas.zip

[SCHENGEN]

أولا : انا متشكر جدا جدا علي الاهتمام والله

ثانيا: This workbook has lost its VBA project, ActiveX controls and any other programmability-related features.

ثالثا: انا مش حريف إكسيل .. ف للأسف باعتمد علي الحاجات البسيطه والمعادلات المعروفه

ياريت لو توضيح بسيط بس .. ومرة تانيا شكرا والله علي الاهتمام

[عبد الفتاح كيرة]

أخى الفاضل

الملف يعمل عندى بطريقة سليمة

أرجو أن يجربه أحد الإخوة

الخلية a1 فى الشيت الأول مرتبطة بمثيلتها فى الشيت الثانى

هل الماكرو مفعل عندك؟

[SCHENGEN]

اسف, تعمل الان

ولكن أخي الكريم, كنت اريد حل ابسط من ذلك لأني هاطبق ده علي خلايا كتير "عمود A1 في صفحة " وعمود كامل في صفحة

مش خلية واحدة بس

[SCHENGEN]

اخي .. لا اريد فقط a1 لكني اريد مثلا من a1:a800

[بن علية حاجي]

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

أخي الكريم إن ما قدمه أخي الحبيب kemas كافي وشافي لما تريد، ومع تغيير طفيف على الكود (وأستسمح أخي كيماس) تصل لمطلوبك حسب ما يلي:

فى الورقة الأولى

Private Sub Worksheet_Change(ByVal Target As Range)

Dim I As Integer

On Error Resume Next

For I = 1 To 800

If Not Intersect(Target, Cells(I, 1)) Is Nothing Then

    Sheets(2).Cells(I, 1) = Sheets(1).Cells(I, 1)

End If

Next I

End Sub

وفى الورقة الثانية

Private Sub Worksheet_Change(ByVal Target As Range)

Dim I As Integer

On Error Resume Next

For I = 1 To 800

If Not Intersect(Target, Cells(I, 1)) Is Nothing Then

    Sheets(1).Cells(I, 1) = Sheets(2).Cells(I, 1)

End If

Next I

End Sub

وفي المرفقات تجد الكود مطبق في ملف أخي كيماس (وتركته باسمه)

connect-kemas_2.rar

أخوك بن علية

[عبد الفتاح كيرة]

شكرا أخى بن علية

بارك الله فيك

لم أجد الوقت الكافى للرد على السائل

[SCHENGEN]

الف الف مليون شكر ... لكم جميعا أخوتي

بجد بجد الف الف شكر

جزاكم الله خيرا