مشكلة فاتورة كهرباء ترحيل بيانات

[ميلان]

السلام عليكم احبائي في الله في هذا المنتدى الجميل لدي ملف شيت فيه بيانات قرابة مئة مشترك شهريا 

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

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

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

اخوكم من سوريا تحية لكم .

فاتورة كهرباء.xlsx

[سليم حاصبيا]

1-الخلايا المدمجة تعيق عمل اي كود او معادلة

    تم تغيير تصميم الورقة الثانية بدون خلايا مدمجة

2- تختار من الخلية I2 الرقم الذي سوف يبدأ العمل منه 

3- اذا كانت الخلية I2  ليست رقما أو اكبر من اخر رقم في الصفحة الأولى يبدأ العداد من الرقم 1

4- اختر الرقم الذي تريده ثم اضغط على الزر  Run

الكود

Option Explicit
Dim s As Worksheet
Dim T As Worksheet
Dim last As Long, Ro%
Dim s_rg As Range
Dim i%, K%, My_ro1%, My_ro2%, My_ro%
Dim m As Byte, n As Byte, xx As Byte
'++++++++++++++++++++++++++++++++
Sub Fatura()

Application.ScreenUpdating = False

 Set s = Sheets("Source")
 Set T = Sheets("Target")
 xx = 1
last = s.Cells(Rows.Count, 1).End(3).Row
If Val(T.Range("I1")) <= 0 Then
  i = 1
 Else
  i = Int(Abs(T.Range("I1")))
 End If
 
 T.Range("I1") = i
 T.Range("Rg_ALL").ClearContents
  For K = i + 3 To i + 10
  If K > last Then Exit For

 Select Case xx Mod 8
  Case 1: m = 2: n = 2
  Case 2: m = 2: n = 4
  Case 3: m = 10: n = 2
  Case 4: m = 10: n = 4
  Case 5: m = 18: n = 2
  Case 6: m = 18: n = 4
  Case 7: m = 26: n = 2
  Case 0: m = 26: n = 4
  End Select
   s.Cells(K, 1).Resize(, 7).Copy
   T.Cells(m, n).PasteSpecial _
   xlPasteValuesAndNumberFormats, Transpose:=True
   xx = xx + 1

Next
Application.CutCopyMode = False
Print_Area
T.Cells(2, 1).Select
Application.ScreenUpdating = True
End Sub
'+++++++++++++++++++++++++++++++++++
Sub Print_Area()
Set T = Sheets("Target")
Ro = T.Cells(Rows.Count, 3).End(3).Row
 For i = 2 To Ro - 6 Step 8
    If T.Cells(i, 4) <> "" Then
       My_ro1 = i + 6
    End If
 Next
 
 For i = 2 To Ro - 6 Step 8
     If T.Cells(i, 2) <> "" Then
       My_ro2 = i + 6
    End If
 Next
 My_ro = Application.Max(My_ro1, My_ro2)
  
 T.PageSetup.PrintArea = T.Range("A1:D" & My_ro).Address
End Sub

الملف مرفق

 

 

 

 

Mhd_Syr.xlsm

[سليم حاصبيا]

ملف احر اكثر توضيحاً

(يسمح لك بقص الفواتير  كل واحدة منفردة ) و ذلك بوضع صف فارغ تحتها وعامود فارغ الى جانبها)

 اذا كانت هناك فواتير فارغة لا تطبع

Mhd_Sr.xlsm

[abouelhassan]

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

[ميلان]

استاذ @سليم حاصبيا  شكرا كثيرا لمجهودك الكبير استاذنا  لم اتوقع الرد على سؤالي من احد لكن نعم 

هناك استاذ سليم دائما في كل مكان شكرا جزيلا لك . 

 

[سليم حاصبيا]

الرّجاء اخباري اي ملف من الاثنين سوف تستعمل

[ميلان]

اظن ان الملف الثاني افضل جزاك الله كل خير يا استاذنا الكبير سليم اظن ان الملف الثاني يفي بالغرض 

كل التحية والحب والاحترام لمجهودك الرائع .