aboesa قام بنشر مايو 26, 2019 مشاركة قام بنشر مايو 26, 2019 السلام عليكم : اريد كود ترحيل البيانات من data الي الشهادات حسب فئة الفصل الموجود في الخلية F2 .مع زيادة عدد الشهادات حسب عدد الفصل .مع الشرح والتوضيح. بارك الله فيكم طباعة شهادات.xlsm 1 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر مايو 27, 2019 مشاركة قام بنشر مايو 27, 2019 اتفضل الملف لعله يفى بالغرض نسخة من طباعة شهادات.xlsm 4 رابط هذا التعليق شارك More sharing options...
aboesa قام بنشر مايو 27, 2019 الكاتب مشاركة قام بنشر مايو 27, 2019 استاذ وجيه شرف الدين بارك الله فيكم وزادكم من علمة .تقبل الله منا ومنكم صالح الأعمال . 1 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر مايو 27, 2019 مشاركة قام بنشر مايو 27, 2019 جزاكم الله خير ولكم بمثل ما دعوت رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مايو 27, 2019 مشاركة قام بنشر مايو 27, 2019 بعد اذن الاخ وحيه هذا الماكرو Option Explicit Sub Get_Blanks() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim Pr As Worksheet Dim Da As Worksheet Set Pr = Sheets("Print") Set Da = Sheets("Data") Dim LR_Pr%, k% Dim separator%: separator = 14 If IsError(Application.Match(Pr.Range("f2"), Da.Range("G:G"), 0)) Then MsgBox "Wrong name of Section" Pr.Range("A14:f5000").Clear GoTo Exit_Sub End If Dim x%: x = Application.CountIf(Da.Range("G:G"), Pr.Range("f2")) LR_Pr = Pr.Cells(Rows.Count, "b").End(3).Row If LR_Pr > 13 Then Pr.Range("a14").Resize(LR_Pr, 6).Clear End If For k = 1 To x - 1 Pr.Range("PRINCE_RG").Copy Pr.Range("a" & separator).PasteSpecial separator = separator + 14 Next Application.CutCopyMode = False fill_data Pr.Range("c4").Select Exit_Sub: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub Rem==================================== Sub fill_data() Dim col_Dt As New Collection Dim Pt As Worksheet: Set Pt = Sheets("Print") Dim Dt As Worksheet: Set Dt = Sheets("Data") Dim First_Row_dt%, Fix_Row_dt% Dim find_rng As Range Dim kk%: kk = 4 Dim Collec_num% Set find_rng = Dt.Range("g:g").Find(Pt.Range("f2")) If Not find_rng Is Nothing Then Fix_Row_dt = find_rng.Row: First_Row_dt = Fix_Row_dt col_Dt.Add Dt.Cells(Fix_Row_dt, 1).Value Do Set find_rng = Dt.Range("g:g").FindNext(find_rng) Fix_Row_dt = find_rng.Row If First_Row_dt = Fix_Row_dt Then Exit Do col_Dt.Add Dt.Cells(Fix_Row_dt, 1).Value Loop End If For Collec_num = 1 To col_Dt.Count Pt.Range("c" & kk) = col_Dt(Collec_num) kk = IIf(kk < 15, kk + 13, kk + 14) Next Set col_Dt = Nothing End Sub الملف مرفق Print_Shahadat.xlsm 3 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر مايو 27, 2019 مشاركة قام بنشر مايو 27, 2019 بارك الله فيكم جميعا كلها حلول ممتازة 2 رابط هذا التعليق شارك More sharing options...
aboesa قام بنشر مايو 27, 2019 الكاتب مشاركة قام بنشر مايو 27, 2019 حبيبي الاستاذ سليم بارك الله فيك وزادك من علمه 1 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر مايو 28, 2019 مشاركة قام بنشر مايو 28, 2019 الله عليك استاذ سليم انت رائع ومبدع جزاكم الله خير 1 رابط هذا التعليق شارك More sharing options...
احمد بدره قام بنشر مايو 28, 2019 مشاركة قام بنشر مايو 28, 2019 بارك الله فيك أستاذ سليم وأستاذ وجيه 2 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر مايو 28, 2019 مشاركة قام بنشر مايو 28, 2019 2 دقائق مضت, احمد بدره said: بارك الله فيك أستاذ سليم وأستاذ وجيه جزاكم الله خير استاذ احمد مرورك العطر هذا 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.