قص و حذف فى نفس الوقت

[خالد الشاعر]

السادة الخبراء

عندى ملفان مفتوحان فى نفس الوقت

اريد كود يعمل الاتى

1- قص بعض الصفوف دون ترك مكانهم خالى

2- لصق هذه الصفوف فى الملف الاخر

هل هذا ممكن

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

ثم ارجع تاني للملف الاول اعم حذف للصفوف الفارغة

فهل ممكن نعمل هذا فى خطوة واحدة

اسف على كثرة الاسئلة

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

[عبدالله المجرب]

ارفق ملف

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

هذا مجرد مثال

يمكن تطويره حسب رغبتك ان اردت

' الشرط الأول ان الملفين يجب ان يكونا في نفس المجلد

' الشرط الثاني هو ان الملف الذي تريد اللصق فيه اسمه 2 أي رقم 2

' يمكن تغيير ذلك حسب رغبتك

Private Sub CommandButton1_Click()

If Dir(ThisWorkbook.Path & "\2.xls") <> "" Then

Selection.Cut

Workbooks.Open (ThisWorkbook.Path & "\2.xls")

ActiveSheet.Range("A1").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Else

1 MsgBox "الملف غير موجود", vbInformation, "خطأ"

Application.CutCopyMode = False

End If

End Sub

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

أو ان أردت مثال آخر ، افتح الملف المسمى رقم 1

أكتب في الخلية B2 اسم الملف

اكتب في الخلية B3 الخلية التي تريد اللصق فيها

تم حدد الصفوف التي تريد قصها

ثم اضغط على قص البيانات

المرفق يحتوي على ملفين في مجلد واحد

افتح الملف المسمى 1 فقط

مجلد جديد.rar

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

وقع سهوا خطأ في الكود

السطر :

If Dir(ThisWorkbook.Path & "\2.xls") <> "" Then

يعوض بالسطر التالي

If Dir(ThisWorkbook.Path & "\" & Range("B1") & ".xls") <> "" Then

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

التصحيح

مجلد جديد.rar

[خالد الشاعر]

استاذ ابو حنين

الف شكر و تسلم ايدك على هذا العمل الرائع

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

هل اطمع فى طلب اخير

بعد اذن الاستاذ عبد الله

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

هل ممكن تعديل امر النسخ الى الامر الجديد الخاص بكم قص البيانات

ولكم جزيل الشكر

استيراد بيانات من ملف.rar

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

ارجو التوضيح

من اين يكون القص

و اين يكون اللصق

[خالد الشاعر]

استاذ ابو حنين

شكراً للاهتمام

ملف الاستاذ عبد الله

يقوم منه بفتح اى ملف اكسل اخر وياخذ منه بعض البيانات copy ثم يلصف فى الملف الاساسى " استيرداد بيانات من ملف "

اريد بدل ما ياخذ copy ياخذ cut للصفوف فى الملف الاساسى " استيرداد بيانات من ملف "

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

[عبدالله المجرب]

استاذ ابو حنين

شكراً للاهتمام

ملف الاستاذ عبد الله

يقوم منه بفتح اى ملف اكسل اخر وياخذ منه بعض البيانات copy ثم يلصف فى الملف الاساسى " استيرداد بيانات من ملف "

اريد بدل ما ياخذ copy ياخذ cut للصفوف فى الملف الاساسى " استيرداد بيانات من ملف "

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

في كود فورم النسخ

تم اضافة هذا السطر ليتم حذف البيانات المنسوخة

    .Delete Shift:=xlUp

ليصبح الكود

Private Sub KHCOPYMYRANGE_Click()

  On Error Resume Next

  If RefEdit1.Text = "" Then GoTo 1

  On Error GoTo 1

  kh_focopy.Hide

  Application.ScreenUpdating = False

    With Range([RefEdit1])

	    .Copy

			    MyCell.PasteSpecial MyPasteSpecial

	    Application.CutCopyMode = False

    MsgBox "تم استيراد عدد " & Chr(32) & .Rows.Count & Chr(32) & " من السجلات بنجاح", 524288 + vbMsgBoxRtlReading, "الحمدلله"

	 .Delete Shift:=xlUp

	 End With


    Application.ScreenUpdating = True

    Mybook.Activate

    Unload kh_focopy

    GoTo 2

1:

MsgBox "استخدام خاطىء", 524288, "تنبيه"

On Error GoTo 0

2 End Sub

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

    .Delete Shift:=xlUp

[خالد الشاعر]

استاذ عبد الله المجرب

الف شكر و تسلم ايدك

الكود يعمل بنجاح ولكن هل ممكن يعمل delete للصف كلة وليس الخلايا المنسوخة

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

[عبدالله المجرب]

السلام عليكم

استبدل ذلك السطر بهذا

.EntireRow.Delete

[خالد الشاعر]

استاذ عبد الله المجرب

تسلم ايدك الف شكر على هذه الحل الممتاز

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