انشاء كود ترحيل وكود طباعة

[نثغةثمسخبف]

من مناهل هذا المنتدى اصبحت اصنع ملفات اكسيل

ملفي اليوم شارف على الانتهاء ولكن بقي لي موضوعين لم افلح بهم

ترحيل وطباعة . قمت باختصار الملف الى مايهمني

الرجاء المساعدة  ... عنوان مخالف ... تــــم تعديل عنوان المشاركة ليعبر عن طلبك

للانترنت.xlsm

[محمد يوسف ابو يوسف]

اخي نثغةثمسخبف   :  شرح غير واضح

يورجي التوضيح

المدي المراد ترحيلة

هل هي خليه متفرقة 

ام تريد الترحيل من a3:x15

والي اي شيت تريد الترحيل

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

[نثغةثمسخبف]

قمت باضافة بعض المعلومات لتصبح اسهل بالمطلوب اخوتي الاعزاء

وشكرا جزيلا لكم ووضع عملكم في صحيفة اعمالكم

مثال 3.xlsm

[محمد يوسف ابو يوسف]

اخي  نثغةثمسخبف

تفضل مثال 3.xlsm

معاك خطوة خطوة  .. اخبرني بالنتيجه

 

[نثغةثمسخبف]

الاخ محمد يوسف

شكرا على تفاعلك معي

الملف لايفي بالغرض

قمت انت بترحيل عدة خلايا متفرقة الى صف واحد

بينما المطلوب ترحيل اعمدة وخلايا متفرقة الى اعمدة وخلايا متفرقة اخرى

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

مع جزيل الشكر

[محمد يوسف ابو يوسف]

اخي  نثغةثمسخبف

 

تفضل  مثال 3.xlsm

 

اخبرني بالنتيجه

[حسونة حسين]

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

تفضل اخى 

Sub Transfer_Non_Adjacent_Columns()
    Dim WS As Worksheet, SH As Worksheet
    Dim LR As Long
    Set SH = ThisWorkbook.Worksheets("صفحة العمل")
    Set WS = ThisWorkbook.Worksheets("ترحيل الشراء")
    LR = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With WS.Cells(LR, "A").Resize(4, 1)
        .Value = SH.Range("A12").Value
        .Offset(0, 2).Value = SH.Range("B11:B15").Value
        .Offset(0, 3) = SH.Range("J3:J7").Value
        .Offset(0, 4) = SH.Range("D3:D7").Value
        .Offset(0, 5) = SH.Range("I3:I7").Value
        .Offset(0, 6) = SH.Range("E11:E15").Value
        .Offset(0, 7) = SH.Range("F11").Value
        SH.Range("A12").Value = SH.Range("A12").Value + 1
    End With

 

[نثغةثمسخبف]

اخي محمد

قمت بالسهر ليلة امبارحة

افحص الكود الذي قمت بكتابته

لايسعني الا ان اقول انه رائع وقمت بتعديله حسب خبرتي المتواضعة ونجحت بذلك

تعديل Lr من a الى c ليكون بداية الترحيل الى اخر سطر بالعمود c

وتعديل رقم العمود الذي وضعته رقما 13 الى i3

بقي تعديل بسيط هو انني لا اريد ان يصبح شيت الترحيل فعال وابقى بشيت العمل مع اعطاء رسالة انه تم الترحيل

والطباعة ؟؟؟؟ مع جزيل الشكر

[محمد يوسف ابو يوسف]

اخي   نثغةثمسخبف

الكود بعد اضافة الطباعه والمسج اصبح هكذا

sub SAVE()
Dim Ws As Worksheet: Set Ws = Sheets("صفحة العمل")
Dim Sh As Worksheet: Set Sh = Sheets("ترحيل الشراء")

LR = Sh.Range("a" & Rows.Count).End(xlUp).Row
Sh.Range("a" & LR + 1) = Ws.Range("a2")
Sh.Range("a" & LR + 1).Offset(0, 0) = Ws.Range("a12")

Sh.Range("a" & LR + 1).Offset(0, 2) = Ws.Range("b11")
Sh.Range("a" & LR + 1).Offset(1, 2) = Ws.Range("b12")
Sh.Range("a" & LR + 1).Offset(2, 2) = Ws.Range("b13")
Sh.Range("a" & LR + 1).Offset(3, 2) = Ws.Range("b14")
Sh.Range("a" & LR + 1).Offset(4, 2) = Ws.Range("b15")


Sh.Range("a" & LR + 1).Offset(0, 3) = Ws.Range("J3")
Sh.Range("a" & LR + 1).Offset(1, 3) = Ws.Range("J4")
Sh.Range("a" & LR + 1).Offset(2, 3) = Ws.Range("J5")
Sh.Range("a" & LR + 1).Offset(3, 3) = Ws.Range("J6")
Sh.Range("a" & LR + 1).Offset(4, 3) = Ws.Range("J7")
'
Sh.Range("a" & LR + 1).Offset(0, 4) = Ws.Range("D3")
Sh.Range("a" & LR + 1).Offset(1, 4) = Ws.Range("D4")
Sh.Range("a" & LR + 1).Offset(2, 4) = Ws.Range("D5")
Sh.Range("a" & LR + 1).Offset(3, 4) = Ws.Range("D6")
Sh.Range("a" & LR + 1).Offset(4, 4) = Ws.Range("D7")
'
Sh.Range("a" & LR + 1).Offset(0, 5) = Ws.Range("l3")
Sh.Range("a" & LR + 1).Offset(1, 5) = Ws.Range("l4")
Sh.Range("a" & LR + 1).Offset(2, 5) = Ws.Range("l5")
Sh.Range("a" & LR + 1).Offset(3, 5) = Ws.Range("l6")
Sh.Range("a" & LR + 1).Offset(4, 5) = Ws.Range("l3")
'
Sh.Range("a" & LR + 1).Offset(0, 6) = Ws.Range("e11")
Sh.Range("a" & LR + 1).Offset(1, 6) = Ws.Range("e12")
Sh.Range("a" & LR + 1).Offset(2, 6) = Ws.Range("e13")
Sh.Range("a" & LR + 1).Offset(3, 6) = Ws.Range("e14")
Sh.Range("a" & LR + 1).Offset(4, 6) = Ws.Range("e15")

Sh.Range("a" & LR + 1).Offset(0, 7) = Ws.Range("l3")
Sh.Range("a" & LR + 1).Offset(1, 7) = Ws.Range("l4")
Sh.Range("a" & LR + 1).Offset(2, 7) = Ws.Range("l5")
Sh.Range("a" & LR + 1).Offset(3, 7) = Ws.Range("l6")
Sh.Range("a" & LR + 1).Offset(4, 7) = Ws.Range("l7")
Sh.Range("a" & LR + 0).Offset(1, 7) = Ws.Range("f11")
[a12] = [a12] + 1
Sh.Activate
Sheets(1).Activate
    Reply = MsgBox("                            تم الترحيل بنجاح" & Chr(10) & " هل تريد'طباعة الفاتورة       ", vbYesNo) 'هنا هل تريد طبع النسخ ام لا
     If Reply <> 6 Then Exit Sub 'هنا هل تريد طبع النسخ ام لا

'          ActiveWindow.SelectedSheets.PrintPreview 'معاينة قبل الطباعة '
'         Application.Dialogs(xlDialogPrinterSetup).Show  '''هذا خاص باختيار الطباعه

  Application.ScreenUpdating = False
  With Sheets("صفحة العمل") 'هنا حدد الشيت المراد طباعتة'
    With .UsedRange
      For i = 1 To .Rows.Count
         If .Cells(i, 1).Value = "" Then
           .Cells(i, 1).EntireRow.Hidden = True   '-c معتمد علي العمود  'هذا الستر الذي يمنع الفراغ
         End If
        Next i
      End With
      .PrintOut
     Rows.Hidden = False
  End With
  Application.ScreenUpdating = True
end sub

تفضل  مثال 3.xlsm

اخبرني بالنتيجه 

 

[نثغةثمسخبف]

اخي محمد

ربما لم اوفق ان اوصل لك فكرتي

لغاية الترحيل وظهور نافذة تم الترحيل هل تريد الطباعة . نعم كل شيئ رائع تسلم هالايادي

ولكن صفحة طباعة الشراء . هي عبارة عن شيت تكون فيه معلومات الخلية هي نفسها معلومات مختارة من شيت صفحة العمل بمعادلة ()=

امر الطباعة هي للسطور التي يكون فيها خلايا العمود B من شيت الطباعة لاتساوي 0

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

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

مع جزيل الشكر

[محمد يوسف ابو يوسف]

اخي   نثغةثمسخبف

تفضل  طلبك   مثال 3.xlsm

اخبرني بالنتيجة

[نثغةثمسخبف]

اخ محمد

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

الكود رائع جدا وهو المطلوب

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

سأوضح لك

المجال B1:J10 هو ثابت يظهر بالطباعة دائما

المجال من B21:J26 ايضا ثابت يظهر بالطباعة دائما

نأتي الى المجال B11:J20 تأتي المعضلة

المطلوب

كل خلية ( مدمجة ) من العمود B تساوي الصفر

يصبح المجال للسطرين مهمل بالطباعة

مثال ليكن الخلية B19 تساوي الصفر

يصبح المجال من B19:J20 لايظهر بالطباعة

ايضا الخلية B15 تساوي 0 يصبح المجال B15:J16 مهمل بالطباعة

ايضا الخلية B13 اكبر من 0 يصبح المجال B13:J14 يظهر بالطباعة

اعتقد انني قد وفقت بالشرح

والف شكر على تجاوبك معي

[محمد يوسف ابو يوسف]

اخي  نثغةثمسخبف

اسف علي التأخير لظروف عملي

تفضل  مثال 3.xlsm

 

اخبرني بألنتيجه

[نثغةثمسخبف]

اخي محمد

ربما خطأي هو بالخلية المدمجة . تم تعديل شيت الطباعة وجعلهم كلهم بصف واحد

وتطبيق المعادلة والكود

وقد تم الامر

شكرا جزيلا وجعل تعبك معي ومع المشفى في صحيفة اعمالك

[محمد يوسف ابو يوسف]

اخي  نثغةثمسخبف

هل تم  طلبك ام  مذا تريد