نقل البيانات مع تجاهل الفراغات

[J2006]

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

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

وفي حالة مسح الكميات تكون الصفحة الثانية فاضية

ارجوا المساعدة ............

11.zip

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

السلام عليكم

عند الانتقال الى الورقة الخاصة بالطباعة تتعدل البيانات

Private Sub Worksheet_Activate()
KH_START
End Sub

الكود الخاص بالترحيل KH_START

Sub KH_START()
Dim MyCell As Range
Set MyCell = Range("البيانات")
Dim X As Integer, C As Integer, CC As Integer
Dim R As Integer, RR As Integer
Application.ScreenUpdating = False
'==========================
'  مسح البيانات المرحلة السابقةان وجدت
With ورقة2
    X = .UsedRange.Rows.Count + 6
    .Range("B7:K" & X).ClearContents
End With
'============================
'     ترحيل البيانات الجديدة
RR = 7
With MyCell
    For C = 1 To 3
            CC = Choose(C, 3, 7, 11)
            For R = 1 To .Rows.Count
            If .Cells(R, CC) <> "" Then
               ورقة2.Cells(RR, 2) = .Cells(R, CC - 2)
               ورقة2.Cells(RR, 5) = .Cells(R, CC - 1)
               ورقة2.Cells(RR, 8) = .Cells(R, CC)
               RR = RR + 2
            End If
        Next R
    Next C
End With
Application.ScreenUpdating = True
End Sub

تفضل المرفق

________________________.rar

[سامح حجاب]

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

كيف حالك أخي في الله

هل بالإمكان تعديل بعض الخانات قليلا

فمثلا هل يمكن تعديل الورقة الأولى لكي تكون البيانات كلها في جدول من 3 أعمدة فقط

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

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

كيف حالك أخي في الله

الحمد لله

هل بالإمكان تعديل بعض الخانات قليلا

فمثلا هل يمكن تعديل الورقة الأولى لكي تكون البيانات كلها في جدول من 3 أعمدة فقط

يمكن التعديل ولكن هذا طلب صاحب الموضوع هو عايزه بالشكل ده حسب فهمي للموضوع

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

ولكن حسب ما طلبت

سيكون كود سهل خاصة اذا الغينا دمج الخلايا في ورقة الطباعة

ارسل مرفق ليتم التطبيق عليه

تم تعديل يونيو 4, 2009 بواسطه خبور خير

[سامح حجاب]

لم أكن قد رأيت ردك أخي في الله خبو خير

حيث أني فتحت الصفحة وفتحت ملف الأخ وحاولت تعديله ولكن بطريقة بدائية طبعا

ولكني ربما استغرقت بعض الوقت حتى أفعل الرد

وطبعا ولاشك أن طريقتك أفضل من تلك التي كنت أحاول أن أجريها

ولكني حاولت مد يد العون لأخ في الله

طمعا في الأجر والثواب

ولكنك سبقتني ووفقك الله

وزاد الله في علمك

ولم يكن ردي تعديل عليكم

وأرجو أن تسامحني

[J2006]

جزيت خيرا يااخ خابور خير

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

طلب اخير هل يمكن وضع تذييل ثابت عند طباعة الصفحة الثانية يظهر عند طباعة كل صفحة مثل

---------- --------- اسم البائع ----------------------------------- اسم المشرف

------------------------( ........ )---------------------------------------(............)

----------- التوقيع ( ....... )--------------------------------------(.............)

تم وضع النقط لتصبح الصورة واضحة لكم

اسف على ازعاجكم بطلباتي..........

تم تعديل يونيو 4, 2009 بواسطه J2006

[J2006]

سؤال اخير اريد اضافة بنود في الصفحة الاولى حاولت ولم استطع

ماهي الطريقة لأ ضافة بنود جديدة .

وشاكر لك حسن صنيعك.............

[J2006]

يا اخ خابور خير

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

كما اريد شرح للكود لانني مبتداء .

[جمال الفار]

مشكور اخى على اجاباتك الرائعة التى نستفيد منا كثيرا

[J2006]

قمت بوضع سؤال وقام الاخ خابور بمساعدتي شاكراُ له سرعه التجاوب

لكن لم استطع فهم الكود اريد احد يشرح لي الكود بتفصيل ممل .

لانه عند قيامي بأضافة بعض البنود لم يعمل الكودمعي .

Private Sub Worksheet_Activate()
KH_START
End Sub

و

Sub KH_START()
Dim MyCell As Range
Set MyCell = Range("البيانات")
Dim X As Integer, C As Integer, CC As Integer
Dim R As Integer, RR As Integer
Application.ScreenUpdating = False
'==========================
'  مسح البيانات المرحلة السابقةان وجدت
With ورقة2
    X = .UsedRange.Rows.Count + 6
    .Range("B7:K" & X).ClearContents
End With
'============================
'     ترحيل البيانات الجديدة
RR = 7
With MyCell
    For C = 1 To 3
            CC = Choose(C, 3, 7, 11)
            For R = 1 To .Rows.Count
            If .Cells(R, CC) <> "" Then
               ورقة2.Cells(RR, 2) = .Cells(R, CC - 2)
               ورقة2.Cells(RR, 5) = .Cells(R, CC - 1)
               ورقة2.Cells(RR, 8) = .Cells(R, CC)
               RR = RR + 2
            End If
        Next R
    Next C
End With
Application.ScreenUpdating = True
End Sub

وجدت في الكود الثاني كلمة البيانات ماهو القصود منها .

اليكم المرفق وتم اضافة بنود باللون الاحمر ولم يشملها الترحيل ......

زادكم الله من علمة

3333.rar

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

السلام عليكم

الاخ الفاضل/ J2006 -------حفظه الله

لقد قمت بدمج الطلب الاخير خاصتك في هذا الموضوع

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

هو عبارة عن اسم نطاق قمنا باضافته لنطاق البيانات في الورقة الاولى

ورقة1!$B$5:$L$26

انظر الى الصور ادناه بامكانك تعديل النطاق حسب الصفوف التي تريدها بدون اضافة اعمدة اخرى ===================== وهذا الطلب الاخير خاصتك بدون استخدام اسم نطاق قم بتحديد النطاق الذي تريده في هذه الجزئية من الكود

'=====================================
'  هنا يمكنك تحديد نطاق البيانات
Set MyCell = ورقة1.Range("B5:L61")
'=====================================

تفضل المرفق

______.rar

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

الاخ الفاضل/ جمال الفار -------حفظه الله

تقبل تحياتي وشكري

ودمتم في حفظ الله

.

تم تعديل يونيو 7, 2009 بواسطه خبور خير

[J2006]

تسلم ياخ خابور خير

ودمت لمحبيك

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

السلام عليكم

اخي الفاضل

اسمي خبور وليس خابور ----للمصدر /خبر-اخبار

خبور خير --------- خبر حلو -------خبر سار

فهمت المعنى وهو هرج باللهجة العمانية

[يحيى حسين]

السلام عليكم

شكرا اخي خبور الخير

دائماً مبدع

:)

تحياتي و حبي لك

تم تعديل يونيو 8, 2009 بواسطه justice

[J2006]

سامحني على هذا الخطا الفادح ..........

[كلالي]

السلام عليكم

بارك الله في الجميع وجزا الله كل الخير للأخ خبور