ياسر العربى

الموضوع بسيط
عدل كما بالصورة وخصوصا رؤوس الاعمدة في الشيت الاول والشيت الثاني حتى يكونا متطابقان من حيث رؤوس الاعمدة وفي الخلايا باللون الاخضر في اعلى الشيت نقوم بوضع 
شرط البحث او عمود البحث الذي نريد البحث فيه
ولا يوجد تعديل بالكود في هذه الحالة
وشكرا.

تفضلوا مشاركة منى بالاكواد

Sub Test()
    Dim numx As Long, x As Long, z As Long, bb As Byte
    Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    bb = Range("D1").Value
    numx = bb
    numl = Range("F1").Value
    ReDim y(1 To numl, 1 To 1)
    For x = 1 To numl
        If x = numx Then numx = numx + bb: GoTo 86
        If x <> numx Then
            z = z + 1
            y(z, 1) = x
        End If
86  Next
    If z > 0 Then Cells(1, 1).Resize(z, 1).Value = y()
    MsgBox "Done.....  (-_-)"
End Sub

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

special_sequence.rar

مشكور اخي الغالي ا زيزو  

تفضل اخى الكريم احمد 

            If IsNumeric(Range("BY" & x).Value2) Then
                If Range("BY" & x) <> "" Or Range("BY" & x) <> "" Then
                    Range("CA" & x) = Range("BY" & x).Value + Range("BZ" & x).Value
                Else
                    Range("CA" & x) = ""
                End If
            Else
                Range("CA" & x) = ""
            End If
        
        'ضع الكود  قبل كلمة next
        Next 

ضع هذا الكود  كما هو مذكور قبل كلمة next

تفضل

Shaaban Flaifel.rar

تفضل

عليكم السلام 

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

ياريت ترفق مثال يوضح المطلوب لتتضح الصورة اكثر

وحتى يستطيع الاخوة مساعدتك

تحياتي

تفضل اخي ناصر لعله المطلوب بطريقة بسيطة
 

إضافة شرط على كود جلب بيانات.rar

مشكور اخي الكريم ناصر على موضوعك هذا 

والفضل لك ايضا في تعديلك وتشكيلك للكود ليناسب احتياجاتك

زادكم الله علما وجزيت خيرا

تقبل تحياتي

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

في 12/5/2016 at 10:38, samo52 said:

يا استاذ ياسر لي سؤال الرجاي المساعده فيه

والمطلوب داخل الملف  

وشكرا

حركة حاويات.rar

Sub Yasser()
    Range("B3:G3").Copy ورقة2.Range("B" & [A3].Value + 2)
End Sub

الكود بسيط في حالة نفس ترتيب الحاويات الموجود بالملف اما لو اختلف نعمل كود تاني
دا حل الاخ Samo52 وياريت نغير الاسم للغة العربية

تحياتي

اما اخي medooo1 هشوف حل باذن الله لك 

حركة حاويات.rar

تفضل اخي الكريم شرح مبسط

Sub Test_Yasser_elaraby()
'بداية اول خلية في الخلايا المدمجة
    Range("C4").Select
    'ايقاف تحديث الشاشة حتى لا ترى  معالجة الكود وبطئ التنفيذ
    Application.ScreenUpdating = False
    'حلقة تكرارية لحين تحقق شرط وهو ان يكون اخر خلية عند النزول اسفل بزر End
    'وتكون الخلية فارغة يخرج  الى الرقم 88 خارج الحلقة التكرارية
    Do
        'الغاء دمج اول خلية تم الوقوف عليها
        Selection.UnMerge
        'ومع نفس التحديد يتم عمل ملئ البيانات لنفس البيان بعد الغاء الدمج
        Selection.FillDown
        'ننتقل الى الخلية المدمجة الاخرى
        Selection.End(xlDown).Select
        'اذا كانت الخلية فارغة ينتقل الى 88
        If ActiveCell.Value = "" Then GoTo 88
        'يتم اعادة الحلقة التكرارية باستمرار طالما ان الخلية ليست فارغة ويظل ينتقل الى اسفل ويكررالكود
    Loop
    'بعد الانتهاء يتم تحديد الخلية A1
88  Range("A1").Select
    'اعادة تحديث الشاشة الى الوضع True
    Application.ScreenUpdating = True
    MsgBox "تم الغاء الدمج"
End Sub

شرح مبسط للكود

Sub Test_Yasser()
'متغير  واي ونستخدمه في الحلقة التكرارية الاولى ليرمز لرقم الشيت
'متغير اكس وهو خاص بالحلقة التكرارية الثانية ويقوم بعد عدد الاسطر الموجود باه بيانات لمقارنة كل بيان بصفحته
'المتغير اس تي ار   متغير من نوع نصى ليشير الى اسم الشيت وهو يساوي  العمود الخاص بأسماء الصفحات
    Dim Y, X, str As String
    'هنا المتغير واي يبدأ من 2 الى 4 وهي عدد الصفحات من بعد الاولي حتى الاخيرة
    For Y = 2 To 4
        'هنا يتم المرور على كل الشيتات المحددة في الحلقة بخلاف الشيت الاول ومسح محتوياتهم تمهيدا لجلب المحتوى الجديد
        Sheets(Y).Range("C6:F" & Sheets(Y).Cells(Rows.Count, 3).End(xlUp).Row).ClearContents
    Next
    'هناحلقة تكرارية تبدأ بأول صف بيانات وهو 6 حتى نهاية البيانات بالصفحة الرئيسية
    For X = 6 To Cells(Rows.Count, 3).End(xlUp).Row
        'المتغيرالخاص بخليه اسم الشيت حتى يتم نسخ البيانات اليه
        str = Cells(X, 6)
        'هنا يتم نسخ كل صف داخل الحلقة التكرارية ووضعه في الشيت المذكور اسمه بجانب البيانات
        'بفرض في هذا المثال ان المتغير اكس بيساوي 6 في اول حلقة له يبقي السطر البرمجي يصبح هكذا
        ' Range("C6:F6").Copy Sheets("الشركة").Range("C" & Sheets("الشركة").Cells(Rows.Count, 3).End(xlUp).Row + 1)
        Range("C" & X & ":F" & X).Copy Sheets(str).Range("C" & Sheets(str).Cells(Rows.Count, 3).End(xlUp).Row + 1)
    Next
    MsgBox "Done........", 64
End Sub

مشكورين اخواني الكرام

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

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

لعله المطلوب

تحياتي لكم

بيانات الموظفين - Copy.rar

طيب ممكن كل الاحتمالات يعني كام جروب

والاحتمالات اللي ممكن تحصل معاهم

عشان الصورة توضح اكتر

تفضل لعله المطلوب

بيانات الموظفين - Copy.rar

تفضل هل تقصد مثل هذا 

group.rar

السلام عليكم

اخي الكريم  ناصر سعيد

الحمد الله نحن في تمام الصحة لكم كل الشكر والتقدير على اهتمامكم انت والاخ الكريم طائع 

وفقنا الله واياكم

ونتمنى عودة جميع الاحبة الى التفاعل داخل هذا المنتدى العظيم مرة اخرى

تقبلوا فائق احترامي وتقديري

تفضل لعله المطلوب

اكسل - تقسيم الخلايا.rar

دا برنامج مخازن بسيط وفيه الصلاحيات تقدر تطبق مثله

كلمة المرور 123

الصلاحيات 123

تحياتي

برنامج مخازن بسيط.rar

الشكر لكم استاذنا الكريم دغيدي لمروركم الجميل
وتفضل هذا الموضوع لفك حماية محرر الاكواد للامتدادات Xlsm  AND  Xlsb
بدون تحويل الملف الى Xls
https://www.officena.net/ib/topic/66951-فك-حماية-محرر-الاكواد-xlsm-xlsb-بدون-تحويل-الملفات-ل-xls/

تحياتي

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

اما لو كانت كبيرة اما ان تاخذ وقت او هتجدي صعوبة في فكها

تحياتي

هل نزلت الفيديو الموجود باول الموضوع به الشرح افضل

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

اتبع الخطوات جيدا وان شاء الله ستجد الحل
ان لم تصل الى المطلوب اكتب هنا الخطوات التي قمت بها بالتحديد

الله يكرمك اخي ناصر تحياتي لك

وما نحن الا طلاب علم وما زلنا نتعلم من اساتذتنا العظماء داخل المنتدى وخارجه

تقبل تحياتي

باذن الله اقوم بعمل امثلة متعددة على الكود

من ترحيل وبحث واستدعاء داخل الشيت او داخل فورم بحث

اخي الكريم ابراهيم ابو ليله

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

تحياتي لكم