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

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

قام بنشر

السلام عليكم و رحمة الله

اخي طلبك غير واضح

هل تريد ترحيل الاسطر B7:D7 الى اسم الصفحة الموجود في الخلية J7

يا ريت توضحلي العبارة دي

ومرة اخرى (f7,e7) الى صفحة ثانية

هل يتم الترحيل الى نفس الصفحة ام ماذا

قام بنشر (معدل)

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

ثانيا:عند الضغط مرتين على ( j7 ) الترحيل الكامل من ( a7 ) حتى ( f7 ) الى صفحة ثانية موجودة في القائمة المنسدلة (او تصنع سلفا في القائمة المنسدلة قبل البدء في الترحيل )

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

رابعا : بالترحيل المشروط اي البند الثالث من الاسئلة هل استطيع الترحيل مع عمليات حسابية بما معناه (الطول ضرب العرض )او(الطول ضرب العرض و الشرح)

وشكرا

تم تعديل بواسطه atala abo abdo
قام بنشر (معدل)

السلام عليكم

بعد اذن استاذي الحبيب يحيى حسين

هذا الكود حطه في حدث الصفحة الرئيسية


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Address = "$J$5" Then Application.Run ("ALI"): Cancel = True: Exit Sub

End Sub

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

Public Sub ALI()

On Error Resume Next

Application.ScreenUpdating = False

Dim ALI_Range, R1, R2 As Range

Dim sh, s, ASC As Worksheet

Q = æÑÞÉ1.Range("J7").Value

P = æÑÞÉ1.Range("I7").Value

Set sh = Sheets(Q)

Set s = Sheets(P)

Set ASC = Sheets(1)

With sh

T = .Cells(1000, 1).End(xlUp).Row + 1

Set R1 = ASC.Range(Cells(7, "B"), Cells(7, "C"))

Set R2 = ASC.Cells(7, "F")

Set ALI_Range = Union(R1, R2).Copy

.Cells(T, 1).PasteSpecial xlPasteValues

.Application.CutCopyMode = False

End With

With s

T = .Cells(1000, 1).End(xlUp).Row + 1

ASC.Range(Cells(7, "E"), Cells(7, "F")).Copy

.Cells(T, 1).PasteSpecial xlPasteValues

.Application.CutCopyMode = False

End With

Application.ScreenUpdating = True

End Sub

==============================

هل يوجد طريقة للترحيل بطريقة استطيع فيها ترحيل اختياري بما معناه (b7,c7,f7)الى صفحة . ومرة اخرى (f7,e7) الى صفحة ثانية الرجاء دوما الترحيل الى السطر السابع " إقتباس"

==============================

هذا هو عمل الكود

والسلام عليكم

وهذا المرفق

ترحيل_ALI.rar

تم تعديل بواسطه alidroos
  • Like 1
قام بنشر

السلام عليكم

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

في خلايا (i7) و ( J7) مهما أضفت أوراق ستظهر في القائمة المنسدلة عند فتح الملف

هذا الكود في حدث ThisWorkbook


Private Sub Workbook_Open()

Call Alidroos

End Sub

وهذا الكود حطه في مودويل

Public Sub Alidroos()

For Each Sh In ActiveWorkbook.Worksheets

SH_ALI = SH_ALI & "," & Sh.Name

Next Sh

Sheets(1).Activate

With Range("I7,J7").Validation

.Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=SH_ALI

End With

End Sub

والسلام عليكم

قام بنشر (معدل)

السلام عليكم ورحمه الله وبركاته

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

وشكرا

تم تعديل بواسطه leprince2007
قام بنشر

هذا الكود أخى الموجود فى المشاركة التى تخصك هذه:

السلام عليكم

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

في خلايا (i7) و ( J7) مهما أضفت أوراق ستظهر في القائمة المنسدلة عند فتح الملف

هذا الكود في حدث ThisWorkbook


Private Sub Workbook_Open()

Call Alidroos

End Sub

وهذا الكود حطه في مودويل

Public Sub Alidroos()

For Each Sh In ActiveWorkbook.Worksheets

SH_ALI = SH_ALI & "," & Sh.Name

Next Sh

Sheets(1).Activate

With Range("I7,J7").Validation

.Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=SH_ALI

End With

End Sub

والسلام عليكم

قام بنشر

يوجد طرق عدة

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

العادية للأوراق

وسيتم إضافة الورقة الجديدة DataValidation

حط الكود في حدث ThisWorkbook


Private Sub Workbook_NewSheet(ByVal Sh As Object)

If MsgBox("هل تريد إضافة شيت جديد ", vbYesNo, "تأكيد إدراج ورقة جديدة") = vbYes Then

Application.EnableEvents = False

Call Alidroos

Application.EnableEvents = True

MsgBox "تم إدراج الورقة بنجاح مع إضافتها في الـ DataValidation", vbInformation, "الحمد لله"

Else

Application.DisplayAlerts = False

ActiveSheet.Delete

MsgBox "تم إلغاء إدراج ورقة .    ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading

Application.DisplayAlerts = True

Exit Sub

End If

End Sub

Public Sub Alidroos()

For Each Sh In ActiveWorkbook.Worksheets

SH_ALI = SH_ALI & "," & Sh.Name

Next Sh

Sheets(1).Activate

With Range("I7,J7").Validation

.Delete

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=SH_ALI

End With

End Sub

  • 2 years later...
قام بنشر

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

 

اريد مساعدتي في ترحيل البيانات الى شيت اخر مشروط بالتاريخ  كيف يكون ذلك 

 

اي اكواد ترحيل مشروطه بالتاريخ    في انتظار الرد من عملاقة الاكسل الله يبارك فيهم     

 

ابو ميرال   تحياتي للجميع

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