ترحيل صف واحد او نطاق معين

[amir501]

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

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

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

[عادل حنفي]

اللام عليكم

اخي الفاضل

ان شاء الله يمكن ذلك لكن برجاء ارفاق مثالا لتحديد الطلب بالضبط

لاختصار الوقت و الجهد

تحياتي

[amir501]

جزاك الله كل خير للاستجابة السريعة واقدرها لك

تم ارفاق ملف

Desktop.rar

[ابو اسامة العينبوسي]

السلام عليكم

هذا الملف يرحل(كمثال و اعلم انه ليس طلبك تماما) الى الصفحه الثانيه(sheet2) ما تم اختياره من الصفحة الاولى (sheet1)

Dim MyRNG As Range

Set MyRNG = Selection

    For A = 1 To MyRNG.Rows.Count

     For B = 1 To MyRNG.Columns.Count

          Sheets(2).Cells(A, B) = MyRNG.Cells(A, B)

     Next B

    Next A

محل11.rar

[ابو اسامة العينبوسي]

السلام عليكم

هذا الملف يرحل(كمثال و اعلم انه ليس طلبك تماما) الى الصفحه الثانيه(sheet2) ما تم اختياره من الصفحة الاولى (sheet1)

Dim MyRNG As Range

Set MyRNG = Selection

    For A = 1 To MyRNG.Rows.Count

     For B = 1 To MyRNG.Columns.Count

          Sheets(2).Cells(A, B) = MyRNG.Cells(A, B)

     Next B

    Next A

نكمل الحل ان كان المطلوب

[amir501]

السلام عليكم

هذا الملف يرحل(كمثال و اعلم انه ليس طلبك تماما) الى الصفحه الثانيه(sheet2) ما تم اختياره من الصفحة الاولى (sheet1)

Dim MyRNG As Range

Set MyRNG = Selection

    For A = 1 To MyRNG.Rows.Count

     For B = 1 To MyRNG.Columns.Count

          Sheets(2).Cells(A, B) = MyRNG.Cells(A, B)

     Next B

    Next A

نكمل الحل ان كان المطلوب

اخي وحبيبي واستاذي الكريم ابو اسامة

جزاك الله عني كل خير للاسف ليس هذا هو المطلوب

المطلوب كما شرحت في المثال المرفق

الترحيل الى ملف اخر وليس بنفس الشيت كما هو موضح في المثال المرفق

اكرر شكري وامتناني واحترامي لشخصكم الكريم

[ابو اسامة العينبوسي]

السلام عليكم

اكرر ان لم يكن المطلوب بلغنى

لا تنسى فتح المرفقين معاً

Dim MyRNG As Range

Set MyRNG = Selection

    If MyRNG.Interior.ColorIndex = 6 Then

    MsgBox "áÞÏ Êã ÊÑÍíá ÇáäØÇÞ" & vbCrLf & MyRNG.Address(0, 0) & vbCrLf & "ãÓÈÞÇð"

    Exit Sub

    End If

    For A = 1 To MyRNG.Rows.Count

     D = Workbooks("ãÍá22").Sheets(1).Cells(1000, 1).End(xlUp).Row + 1

     For B = 1 To MyRNG.Columns.Count

         Workbooks("ãÍá22").Sheets(1).Cells(D, B) = MyRNG.Cells(A, B)

     Next B

    Next A

    MyRNG.Interior.ColorIndex = 6

محل11.rar

[amir501]

اخي الكريم الكود لا يعمل وهي يمكن للكود ان يقوم بتشغيل الملف الثاني تلقائيا

واشكرك كل الشكر سلفا

[ابو اسامة العينبوسي]

السلام عليكم

هل فتحت المرفقين معا ؟

جربت الملف . شغال

اعد الكره

اما بالنسبة لفتح الملف ممكن ذلك

و الافضل انشاء ملف جديد مطابق لاسم الملف المدرج في الكود

[amir501]

السلام عليكم

هل فتحت المرفقين معا ؟

جربت الملف . شغال

اعد الكره

اما بالنسبة لفتح الملف ممكن ذلك

و الافضل انشاء ملف جديد مطابق لاسم الملف المدرج في الكود

السلام عليكم

نعم لقد قمت بفتح الملفين وعند الترحيل يخبرني بانه تم الترحيل مسبقا وعندما اذهب للملف الثاني لا اجد الترحيل

اما بالنسبة لتشغيل الملف تقصد ان انشا مجلد واسميه محل 1 ام محل 2 وهل اضع الملفين فيه

ولك مني كل الشكر والاحترام

[ابو اسامة العينبوسي]

السلام عليكم

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

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

Dim MyRNG As Range

Set MyRNG = Selection

   For A = 1 To MyRNG.Rows.Count

     D = Workbooks("ãÍá22").Sheets(1).Cells(1000, 1).End(xlUp).Row + 1

     For B = 1 To MyRNG.Columns.Count

         Workbooks("ãÍá22").Sheets(1).Cells(D, B) = MyRNG.Cells(A, B)

     Next B

    Next A

و الملف يرحل الى الورقه الاولى من ملف المحل22

[amir501]

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

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