اذهب الي المحتوي
أوفيسنا

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

قام بنشر

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

هل يمكن عمل كود طباعة لكل صف في ورقة واحدة بزر واحد؟

مرفق ملف بالبيانات

طلاب.xlsx

  • تمت الإجابة
قام بنشر

لا حاجة لادراج آلاف الأسماء (عيّنه بسيطة تكفي)لأن الماكرو ديناميكي يأخذ كل الطلاب مهما كان عددهم

الكود

Option Explicit
Dim i
Dim arr(1 To 6)
Dim Ws As Worksheet
Dim New_sheet As Worksheet
Dim Rg As Range, Spes_Rg As Range, x%
'++++++++++++++++++++++++++++++++++++
Sub ADD_Sheet()
Set Ws = Sheets("KOUSHOUFAT")
arr(1) = "الأوّل": arr(2) = "الثّاني"
arr(3) = "الثّالث": arr(4) = "الرّابع"
arr(5) = "الخامس": arr(6) = "السّادس"
For i = LBound(arr) To UBound(arr)
  If Not Application.Evaluate("ISREF('" & _
     arr(i) & "'!A1)") Then
     Sheets.Add(, Sheets(Sheets.Count)).Name = arr(i)
  End If
Next
End Sub
'++++++++++++++++++++++++++++++++++++
Sub Get_Studiantes()

Application.ScreenUpdating = False
ADD_Sheet

Set Rg = Ws.Range("A1").CurrentRegion
i = 1
For Each New_sheet In Sheets
  If New_sheet.Name <> Ws.Name Then
   New_sheet.Range("A1").CurrentRegion.Clear
  Rg.AutoFilter 3, arr(i)
  Rg.SpecialCells(12).Copy
    With New_sheet.Range("A1")
    .PasteSpecial (8)
    .PasteSpecial (12)
    .PasteSpecial (4)
    End With
  Set Spes_Rg = New_sheet.Range("A1").CurrentRegion
  x = Spes_Rg.Rows.Count
  If x > 1 Then
    Spes_Rg.Cells(2, 1).Resize(x - 1).Value = _
    Evaluate("row(1:" & x - 1 & ")")
  End If
 i = i + 1
 End If
 
 Next
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
 Ws.Select
 Ws.AutoFilterMode = False

End Sub

الملف مرفق

 

jako.xlsm

  • Like 4
قام بنشر

 الأخ سليم حاصبيا

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

هل ممكن ذلك؟ 

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information