للمرة المائة بعد العشرة الآف (
عدم ادراج خلايا مدمجة داخل الجدول)
1-تم ادراج صف في الشيت "فاتورة" فارغ لفصل الجدول عن الخلايا المدمجة (الصف رقم 6
تم اخفاؤه)
2- تم تعبئة الجدول ببيانات عشوائية
3- ازالة الزركشات التي تسبب بتضخيم الملف دون جدوى
الكود
Option Explicit
Sub From_One_To_ALL()
Dim F As Worksheet
Dim Sw As Worksheet
Dim FRg As Range, Srg As Range
Dim Rf%, Cf%
Dim x%, Y%
Set F = Sheets("فاتوره")
Rf = F.Cells(Rows.Count, 4).End(3).Row
Cf = 15
Set FRg = F.Range("C7").Resize(Rf - 12, Cf)
x = FRg.Rows.Count: Y = FRg.Columns.Count
If F.Range("l1") = vbNullString Then Exit Sub
Set Sw = Sheets(F.Range("l1").Value)
Sw.Range("C8").Resize(500, Y).Clear
Sw.Range("C8").Resize(x, Y).Value = _
FRg.Value
With Sw.Range("B8").Resize(x, Y + 1)
.Borders.LineStyle = 1
.Font.Size = 14
.Font.Bold = True
.InsertIndent 1
.Cells(1, 1).Resize(x).Value = _
Evaluate("row(1:" & x & ")")
.Interior.ColorIndex = 35
End With
Set Sw = Nothingg
Set FRg = Nothing
Set Srg = Nothing
End Sub
الملف مرفق