ترحيل البيانات الى ورقه اخرى

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

السلام عليكم

ممكن ترحيل البيانات من ورقة الحوالات الى ورقة اللارشيف

حيث تضاف البيانات الجديده اسفل البيانات القديمه

______.rar

[الدكتور خضر الرجبي]

السلام عليكم

أخي أبا اسامة ، بارك الله فيك

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

دعني أحلق قليل في أفق مسألتك ...

المسألة هي عملية ترحيل من ورقة إلى أخرى بمعنى أبسط نسخ بيانات من ورقة إلى أخرى.

بشكل عام : نسخ بيانات من ورقة إلى أخرى من الممكن أن يتضمن الأفكار الآتية :

1. نسخ مدى واحد
2. نسخ أكثر من مدى
3. نسخ سطر أو سطور
4. عمود أو عدة أعمدة

وغيرها من الأفكار التي لا أستطيع حصرها هنا .

أود هنا أن اناقش الفكرة الأولى

يتم نسخ الكود التالي ووضعه في وحدة نمطية (Alt+11 ثم نضغط Insert ثم نختار module)

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Sub copy_1()
    Dim sourceRange As Range
    Dim destrange As Range
    Dim Lr As Long
    Lr = LastRow(Sheets("Sheet2")) + 1
    Set sourceRange = Sheets("Sheet1").Range("A1:C10")
    Set destrange = Sheets("Sheet2").Range("A" & Lr)
    sourceRange.Copy destrange
End Sub


Sub copy_1_Values_PasteSpecial()
    Dim sourceRange As Range
    Dim destrange As Range
    Dim Lr As Long
    Application.ScreenUpdating = False
    Lr = LastRow(Sheets("Sheet2")) + 1
    Set sourceRange = Sheets("Sheet1").Range("A1:C10")
    Set destrange = Sheets("Sheet2").Range("A" & Lr)
    sourceRange.Copy
    destrange.PasteSpecial xlPasteValues, , False, False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub


Sub copy_1_Values_ValueProperty()
    Dim sourceRange As Range
    Dim destrange As Range
    Dim Lr As Long
    Lr = LastRow(Sheets("Sheet2")) + 1
    Set sourceRange = Sheets("Sheet1").Range("A1:C10")
    With sourceRange
        Set destrange = Sheets("Sheet2").Range("A" & Lr). _
                        Resize(.Rows.Count, .Columns.Count)
    End With
    destrange.Value = sourceRange.Value
End Sub

وإليك المثال التطبيقي على هذا الموضوع : Copy_Range.rar

الجميل في الموضوع أنه عند تكرار عملية النسخ يتم وضع البيانات وراء بعضها .

يمكن اجراء عملية النسخ بضغط مفتاح Alt+F8 وثم تشغيل البرنامج copy

مصدر المعلومات وللتوسع في الموضوع : موقع المبرمج رون - أجنبي

مع الاحترام والتقدير

[omar elhosseini]

الاخ خضر الرجبي

تحياتى

مجموعة افكار رائعة وموقع اكثر من ممتاز .

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

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

الاخوه الافاضل

السلام عليكم

خضر الرجبي و تامر عمر

انا اخوكم عمر العينبوسي من فلسطين

احمل درجه البكالوريوس في التربيه وعلم النفس

اعمل في مجال الصرافه و الصياغه

احب البرمجه و خاصه الاكسل مع الفيجوال بيسك

لدي العشرات من المواقع الاجنبيه و التي هي للحقيقه و الانصاف اكثر من رائعه كما منتدانا العزيز

قد تكون مشاركاتي احيانا غريبه لكن ذلك بهدف عمل برنامج للصرافه

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

البرنامج كبير حجمه 8.9 ميجا

لولا ذلك لاطلعتكم عليه لكن ما من سبيل الى ذلك

اطلت عليكم شكرا

اريد الترحيل ان يكون حسب الملف الذي سارفقه

______.rar

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

السلام عليكم

اخي خضر و اخ تامر ارجو الاطلاع على الملف المرفق في المشاركه السابقه

[omar elhosseini]

اخى عمر

تحياتى لك

اخى مشاركتك ليس بالغريبة

اخى فالإكسيل غالبا ما يلبى معظم احتياجاتنا .

شاهد المرفق لعله هو طلبك .

______2.rar

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

السلام عليكم

الف شكر اخي

بارك الله فيك

و جزاك خيرا