طريقة قص الصف ونسخة بحركة واحدة

[عروب الاعبيدات]

بسم الله الرحمن الرحيم

 

السلام عليكم جميعا

 

 

اريد عمل مشروع في الاكسل 2007

 

المشروع عبارة عن  جدول  مكون  من ( شيتين )صفحتين   الشيت  الاول  عبارة عن  ادخال بيانات  بشكل يدوي  والشيت الثاني  عبارة عن ترحيل بيانات ( قص ولصق فقط من الشيت الاول االى الشيت الثاني

 

اريد طريقة ما .. او زر امر  بحيث   اقوم  بتحديد  صف ما  من الشيت  الاول  ..ونقلة الى صف الشيت الثاني  بالترتيب .اي في اول صف فارغ ( بحركة واحدة فقط ) اي بمعنا بدون تحديد الصف ..ثم  الضغط على قص ثم الذهاب الى الشيت الثاني ثم لصق ..ثم العودة الى الشيت الاول وحذف الصف الفارغ الذي تم نقلة ....الخ

 

و::: اريد  بعد اتمام الامر ::: الرجوع الي  الشيت الاول .. لااجد فراغ  القص ( للصف ) الذي تم قصة ونقلة " ترحيلة .

 

ارجوكم مساعدة

 العمل بالمرفق

store1.rar

[عروب الاعبيدات]

مرحبا

اين الرد

ارجوكم

[أبو حنــــين]

السلام عليكم

يمكن ان تضع هذا الكود في ورقة in

تحدد خلية التاريخ في صفحة  in  فقط

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Last = Sheets("out").Cells(Rows.Count, "A").End(xlUp).Row + 1
    On Error Resume Next
        If Target.Column = 1 Then
        With Range(ActiveCell, ActiveCell.Offset(0, 11))
         .Select
         .Copy Sheets("out").Cells(Last, 1)
         .Delete Shift:=xlUp
    End With
End If
End Sub

تم تعديل يوليو 8, 2013 بواسطه أبو حنين

[عبدالله باقشير]

السلام عليكم

بعد اذن اخي ابو حنين

شاهد المرفق 2010

 

store1.rar

[عروب الاعبيدات]

هذا ما تمنيت  

الله يوفقك ياابوحنين  دنيا واخرة

اطال الله في عمرك

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

ماشاء الله عليك  الله يخليليك اولادك بالصحة والعافية

الف الف الف شكر لك

[حمادة عمر]

[الـعيدروس]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Rm = Range("A3:L10000")
If Not Intersect(Target, Rm) Is Nothing Then
With Target
c = ورقة2.[A65536].End(xlUp).Offset(1, 0).Row
Range(Cells(.Row, 1), Cells(.Row, 12)).Copy (ورقة2.Cells(c, 1)): .EntireRow.Delete
End With
End If
End Sub

السلام عليكم

او في حدث الدبل كليك ( نقر مرتين )

انسخ الكود في حدث الورقة