اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

الكود التالى للأستاذ الكبير الخبير عميد قسم الإيكسيل الذى ننتظر بفارغ الصبر أن يعود سريعاً ليمتعنا بأعماله الرائعة

طبعاً تعرفونه دون ذكر إسمه إنه أستاذنا المبدع خبور خير

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

خاصة كيف أحدد العمود فى الشيت الرئيسى الذى سيحتوى على الكلمات التى بناء عليها سيقوم الكود بالترحيل إلى الشيتات الأخرى


Sub Khboor_Tarheel()

'=============================================

' الية الكود بعد الترحيل يقوم بمسح البيانات التي تم ترحيلها

On Error Resume Next

Application.ScreenUpdating = False

For a = 2 To [a200].End(xlUp).Row

	If Cells(a, 1) <> "" Then

		MySheets = Cells(a, 1)

		With Sheets(MySheets).[a200].End(xlUp)

		.Offset(1, 0) = Cells(a, 1)

		 .Offset(1, 1) = Cells(a, 2)

		   .Offset(1, 2) = Cells(a, 3)

		 .Offset(1, 3) = Cells(a, 4)

		End With

	End If

' If Sheets("ورقة1").Cells(a, "a") > "" Then Cells(a, 3).Resize(1, 4).Value = "" ' اذا اردت مسح البيانات بعد الترحيل حفز هذا السطر

Next a

Application.ScreenUpdating = True

MsgBox "!تم الترحيل   بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل"

Range("a2").Select

On Error Resume Next

On Error GoTo 0

End Sub

قام بنشر

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

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

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information