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

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

قام بنشر
السلام عليكم ورحمه الله
ارجو المساعده في الشيت المرفق
الشيت فيه 3 صفحات اول صفحه فيها اسماء بالعناوين وتاني صفحه فيها نموذج
انا عايزه اخد الاسماء دي كل 16 اسم بالعناوين ال قدمهم واحطهم في النموذج ال في الورقة التانيه علشان تديني النتيجه ال في الورقة التالته
يعني انا حاطه الورقة التالته علشان تشوفو النتيجه في الاخر ازاي
انا عايزه اعمل كود ينقلي الاسماء بالعناوين كل 16 اسم في النموذج ال في الورقة 2 بحيث انا بعد ما يخلص اطبع النموذج ال في الورقة 3 بالاسماء كل 16 اسم في ورقة لوحده

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

VIVA.xlsm

  • أفضل إجابة
قام بنشر

ممكن هذا الكود

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

Option Explicit
Sub Extract_by_16()
Rem Created by Salim Hasbaya On 12/10/2019
Application.ScreenUpdating = False
Dim my_rg, i%, X, last_range As Range
Dim S As Worksheet
Dim T2 As Worksheet
Set S = Sheets("sheet1")
Set T2 = Sheets("Templete_2")
Dim lra%: lra = S.Cells(Rows.Count, 1).End(3).Row
Dim m%: m = 13
 
 For i = m To 2500 Step 37
  T2.Cells(i, 4).Resize(16, 2).ClearContents
 Next
  m = 13

For i = 2 To lra Step 16
    If lra - S.Cells(i, 1).Row < i Then
        X = lra - i
         Set last_range = _
         S.Cells(i, 1).Resize(X + 1, 2)
         Exit For
    End If
        Set my_rg = S.Cells(i, 1).Resize(16, 2)
        T2.Cells(m, 4).Resize(16, 2).Value = _
        my_rg.Value
        m = m + 37
Next i
If Not last_range Is Nothing Then
 T2.Cells(m, 4).Resize(X + 1, 2).Value = _
 last_range.Value
End If
Application.ScreenUpdating = True
End Sub

الملف مرفق

 

 

VIVA_Mia.xlsm

  • Like 2
قام بنشر

جزاك الله خيرا يا استاذ سليم

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

وانا حاولت اعمل كده بس ما ظبطش معايا وبيطلعي النموذج لاول 16 اسم فقط انما باقي الاسماء بتتحط في صفوف عاديه من غير النموذج

زي كده

VIVA_Mia.xlsm

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information