اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم

المعطيات:

1. عندي جدول رئيسي (ورقة عمل1) وفيه جميع اسماء الموظفين وتقسيمهم الى ثلاث مجموعات

2. عملت ثلاث جدوال فرعية آخرى على حسب المجموعات في ورقة عمل 2 و 3 و 4

المطلوب:

كيف اربط الجداول الفرعية في اوراق العمل مع الجدول الرئيسي؟

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

الشرح موجود في ملف الاكسل

شكرا مقدما

employer.rar

قام بنشر

تفضل أخى


Sub ragab()

Dim i As Integer, x As Integer

Dim LR As Integer, y As Integer, z As Integer

'============================================================

LR = [F10000].End(xlUp).Row

Application.ScreenUpdating = False

'============================================================

Sheets("المجموعة الاولى").Range("A2:F1000").ClearContents

Sheets("المجموعة الثانية").Range("A2:F1000").ClearContents

Sheets("المجموعة الثالثة").Range("A2:F1000").ClearContents

'============================================================

x = 2: y = 2: z = 2

For i = 3 To LR

    If Cells(i, 6).Value = 1 Then

	    Range("A" & i).Resize(1, 6).Copy

	    Sheets("المجموعة الاولى").Range("A" & x).PasteSpecial xlPasteValues

	    x = x + 1

    ElseIf Cells(i, 6).Value = 2 Then

	    Range("A" & i).Resize(1, 6).Copy

	    Sheets("المجموعة الثانية").Range("A" & y).PasteSpecial xlPasteValues

	    y = y + 1

    ElseIf Cells(i, 6).Value = 3 Then

	    Range("A" & i).Resize(1, 6).Copy

	    Sheets("المجموعة الثالثة").Range("A" & z).PasteSpecial xlPasteValues

	    z = z + 1

    End If

Next i

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub


employer.rar

قام بنشر

وهذا كود آخر يعتمد على تسمية الشيتات بنفس أسماء المجموعات أى 1 و 2 و 3


Sub ragab()

Dim Sh As String, i As Integer

'============================================

LR = [F10000].End(xlUp).Row

Application.ScreenUpdating = False

'============================================

Sheets("1").Range("A2:F1000").ClearContents

Sheets("2").Range("A2:F1000").ClearContents

Sheets("3").Range("A2:F1000").ClearContents

'============================================

For i = 3 To LR

Sh = Cells(i, 6).Value

AA = Sheets(Sh).Cells(1000, 1).End(xlUp).Row + 1

On Error Resume Next

Range(Cells(i, "A"), Cells(i, "F")).Copy

Sheets(Sh).Range("A" & AA).PasteSpecial xlPasteValues

Application.CutCopyMode = False

Next i

Application.ScreenUpdating = True

End Sub

employer2.rar

قام بنشر

وهذا كود للترحيل التلقائى بمجرد كتابة رقم المجموعة فى العمود F


Private Sub Worksheet_Change(ByVal Target As Range)

Dim Sh As String, i As Integer

'============================================

LR = [F10000].End(xlUp).Row

Application.ScreenUpdating = False

'===========================================================

If Not Intersect(Target, Range("F3:F" & LR)) Is Nothing Then

Sheets("1").Range("A2:F1000").ClearContents

Sheets("2").Range("A2:F1000").ClearContents

Sheets("3").Range("A2:F1000").ClearContents

'============================================

For i = 3 To LR

Sh = Cells(i, 6).Value

AA = Sheets(Sh).Cells(1000, 1).End(xlUp).Row + 1

On Error Resume Next

Range(Cells(i, "A"), Cells(i, "F")).Copy

Sheets(Sh).Range("A" & AA).PasteSpecial xlPasteValues

Application.CutCopyMode = False

Next i

Application.ScreenUpdating = True

End If

End Sub

employer3.rar

قام بنشر

أستاذى الحبيب / عبد الله باقشير

شكرا جزيلا أستاذى الحبيب على اعطائى شرف هذا المرور الكريم والعطر

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

قام بنشر

الاخ الحبيب رجب الكود الثالث اكثر من رائع ولكنة ينقصة الاضافات التالية

1 - بعد الكتابة فى الصفحة الرئيسية اريد ان ايتم مسح البيانات المكتوبة فى الصفحة ان يتم مسحها

2 - اذا اردت تغير المدى ولتكن الخان h مثلا بدلا من f اى سطر فى الكود يتم تغيرة

3 - حاولت التعديل على الكود لاحظ الصورة

شكرا لسيادتكم وجعلة فى ميزان حسناتك

post-54515-0-88426200-1352228365_thumb.j

قام بنشر

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

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

اسف جدا وشكرا جزيلا لحسن تعاونكم

قام بنشر

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

أستاذي رجب جاويش

بارك الله فيك أكواد رائعة

أفضل مافيك أنك تريد خدمت إخواتك في المنتدي

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

تلميذك أحمد فؤاد

قام بنشر

أخى الفاضل / أحمد فؤاد

العفو أخى

بل نحن أخوة نتعلم من بعضنا البعض ومن أساتذة هذا الصرح الكبير مثل الأستاذ الكبير / عبد الله باقشير والأستاذ / الخالدى والاستاذ / عبد الله المجرب و غيرهم الكثير

قام بنشر

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

أخي الفاضل حسين حفظكم الله

بعد إذن أستاذي النبيل رجب جاويش حفظه الله

ما القصد إلا تخفيف الضغط عليه في الأشياء البسيطة.

خالص الشكر للأستاذ الفاضل مرعي السيد حفظه الله

تم الأستفادة من ملف له

تم تصحيح بعض المعادلات(لأخطاء طفيفة فيها) كي تعمل مع الكود.

في الأخير أرجو أن يكون المطلوب.

المرفق

حسين معادلات بالكود.rar

أبو أنس ناصر حاجب

قام بنشر

أخى الحبيب / أبو أنس حاجب

حفظك الله من كل مكروه

وخفف الله عنك كل متاعب الحياه

وأزال عنك كل الهموم

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

تسلم ايديك

  • 1 year later...
قام بنشر

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

  • 4 months later...
قام بنشر

ماشاء الله لاقوة الا بالله

 

بارك الله فيكم

 

سؤالي اخي رجب : حاولت ان اقلد عملك ، ولكن عجزت 

 

لا ادري اين اضع كود الترحيل او الاكواد الاخرى.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information