اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

السلام عليكم

 

استخدم الكود التالي:


 

Sub kh_Start()
Dim Cel As Range
Dim r As Integer, rr As Integer
For Each Cel In Range("C6:C12")
    rr = Val(Cel)
    If rr Then
        With ورقة2.Range("A2").Cells(rr, Columns.Count).End(xlToLeft)
            .Offset(0, 1).Value = Cel.Offset(0, 2).Value
        End With
    End If
Next
End Sub

 

في امان الله

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

شكرا لك أستاذ خبور

دوما رائع mahmoud-lee

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

وارجو التقييم من قبلكم حتى أتعلم

ترحيل أبو محمد.rar

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

عاشق الاكسل

العالم الجليل / عبدالله بقشير

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

اولا اسمح لى ان اعرب ان اسفى لتأخرى على الرد ولكن بسبب ظروف خارجة عن ارادتى بسبب مشاكل فى النت .

واسمح لى ان اعرب عن سعادتى وامتنانى وشكرى لمشاركتك وكودك العظيم والجميل مثلك .

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

ولكن كل مافى وسعى ان ادعو لسيادتكم بدوام الصحة والعافية والتوفيق وان تكون هذة الاعمال فى ميزان حسناتكم يوم القيامة اللهم امين .

استاذى الفاضل /محمود لى

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

ولكن ياحبيبى امتعتنى بمعادلتك الرائعة مثلك . فكل الحب والتقدير لمجهوداتكم الكريمة

الاستاذ الفاضل / محمد ابو شرف

سعيد جدا بمشاركتك وجزاك الله كل خير .

قام بنشر

السلام عليكم

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

 

بالنسبة للطلب:

هذا الكود:


 

Sub kh_Start()
Dim Cel As Range
Dim Adr As String
Dim r As Integer, rr As Integer

Adr = [J3]

For Each Cel In Range("C6:C12")
    rr = Val(Cel)
    If rr Then
        With ورقة2.Range(Adr).Cells(rr, Columns.Count).End(xlToLeft)
            .Offset(0, 1).Value = Cel.Offset(0, 2).Value
        End With
    End If
Next
MsgBox "تم الترحيل بنجاح"
End Sub

 

المرفق 2003

كود زر ترحيل1.rar

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

عاشق الاكسل

عالمنا الجليل / عبدالله بقشير

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

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

مرفق الملف وموضح به المطلوب الجديد

وانا كلى شوق ولهفة فى انتظار مزيد من الابداع والاستمتاع والجمال مع اكواد عاشق الاكسل

عالمنا الجليل / عبدالله بقشير

والف مليون شكر

كود زر ترحيل111.rar

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

السلام عليكم 

 

هذا تعديل لكود الاستاذ عبدالله باقشير

ub kh_Start()
Dim Cel As Range
Dim Adr As String
Dim r As Integer, rr As Integer
MyDay = Val([B3])
Select Case [C3].Value
    Case Is = "سبتمبر"
     MyMonth = 0
Case Is = "اكتوبر"
     MyMonth = 12
Case Is = "نوفمبر"
     MyMonth = 24
End Select
Adr = [J3]
For Each Cel In Range("C6:C12")
    rr = Val(Cel)
    If rr Then
        With ورقة2.Range(Adr).Cells(rr, MyDay + MyMonth + 1)
            .Offset(0, 1).Value = Cel.Offset(0, 2).Value
        End With
    End If
Next
MsgBox "تم الترحيل بنجاح"
End Sub

قام بنشر

السلام عليكم

 

الشكر واصل لاخي الحبيب عبدالله

واتمنى ان يكون هذا آخر طلب

 

انا عدلت في المعادلة بداخل الشيت

في الخلية J3

 

=ADDRESS(VLOOKUP(D3;N2:O5;2;0);((MATCH(C3;R2:R4;0)-1)*12)+B3+2)
 

 

مع تعديل بسيط للكود

Sub kh_Start()
Dim Cel As Range
Dim Adr As String
Dim r As Integer, rr As Integer

Adr = [J3]
For Each Cel In Range("C6:C12")
    rr = Val(Cel)
    If rr Then
        With ورقة2.Range(Adr).Cells(rr, 1)
            .Value = Cel.Offset(0, 2).Value
        End With
    End If
Next
MsgBox "تم الترحيل بنجاح"
End Sub

 

في امان الله

كود زر ترحيل111.rar

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

عالمنا الجليل

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

حل رائع  كالعادة . جزاك الله كل خير وبارك فيك .وزادك الله من علمه وفضله اللهم امين

أنا اسف جدا لاننى اثقلت على سيادتكم بالاسئلة . وارجو تقبل اسفى وعذرى

كل الشكر والتقدير والحب لسيادتكم  مع تمنياتى لكم بالتوفيق ودوام الصحة ومزيد من العلم والتقدم .

وللمرة الثانية بالله عليك سامحنى ان كنت اثقلت عليك واوعدك اننى لن اثقل عليك مره اخرى ولن يتكرر هذا مرة اخرى

استاذى الفاضل / المايسترو

والله زمان ياحبيبى . وحشتنا ووحشتنا ابداعاتك  واعمالك الجميلة

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

والف مليون شكر

وشكرا

تم تعديل بواسطه فضل 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