ياسر خليل أبو البراء

أخي الكريم قصي شاهد الفيديو التالي عله يفيدك

لا مجال هنا لوضع شرط حيث أن الكود يقوم بنقل البيانات في الأعمدة دفعة واحدة دون الحلقات التكرارية ..

وجزيت خيراً بمثل ما دعوت لي أخي الكريم حسين

الحمد لله نخن بخير والله ومشكور على سؤالك عني .. وبالنسبة للنسيان : كيف أنسى أحبتي في الله؟ أنت بالذات لك معزة خاصة في قلبي أنت وسالم شباني .. بارك الله فيك ونرجو أن تكون دائماً فيما بيننا وألا تنقطع عنا

ارفق الملف النهائي للإطلاع عليه ومعرفة أين الخلل؟

هل جربت نفس الحل الذي قدمته في الموضوع الآخر .. باستخدام دالة INSTR ...؟!

يا ترى بحلم ولا بحلم ولا يمكن بتخيل .. هو أنا عيني شايفة البوست دا ولا دي خيالات .. ربنا يستر علي معقولة خالد القدس أخيراً ظهر وبااااااااااااااااااااان .. والله والله والله ليك وحشة يا غالي (دا كلام تغيب عننا كل الفترة دي ..)

استبدل السطر التالي If Arr(i, 4) = "مستجد" Then إلى If Instr(Arr(i, 4), "مستجد*") > 0 Then واحذف سطر الترقيم Cells(p + 7, "B") = p

غير السطر التالي If arr(i, 5) = kName Then إلى If arr(i, 5) Like kName Then

وعليكم السلام جرب خد مسافات بالمسطرة قبل عنوان الفورم إلى أن يتوسط العنوان

جرب تغير السطر التالي If Arr(i, 4) = "مستجد" Then إلى If Arr(i, 4) Like "مستجد" Then

أخي الكريم يرجى طرح موضوع لكل طلب جديد .. راجع التوجيهات في الموضوعات المثبتة في صدر المنتدى

السلام عليكم .. جرب الكود التالي عله يفي بالغرض Sub TransferNonAdjacentUsingArrays() Dim ws As Worksheet Dim sh As Worksheet Dim kName As String Dim arr As Variant Dim temp As Variant Dim i As Long Dim j As Long Dim p As Long Set ws = Sheets("بيانات الطلاب") Set sh = Sheets("سجل قيد الطلاب المستجدين") kName = "مستجد" Application.ScreenUpdating = False arr = ws.Range("B17:T" & ws.Range("B" & Rows.Count).End(xlUp).Row).Value temp = sh.Range("B11:P" & UBound(arr, 1)).Formula For i = 1 To UBound(arr, 1) If arr(i, 5) = kName Then p = p + 1 temp(p, 2) = arr(i, 2) temp(p, 4) = arr(i, 7) temp(p, 5) = arr(i, 8) temp(p, 6) = arr(i, 9) temp(p, 10) = arr(i, 13) temp(p, 11) = arr(i, 4) temp(p, 12) = arr(i, 5) temp(p, 14) = arr(i, 11) temp(p, 15) = arr(i, 12) End If Next i If p > 0 Then sh.Range("B11").Resize(p, UBound(temp, 2)).Value = temp Application.ScreenUpdating = True End Sub

يفضل طرح موضوع جديد لكل طلب جديد تيسيراً للبحث فيما بعد

استبدل هذا الجزء "Exported.pdf\ بهذا الجزء \" & ThisWorkbook.Name & ".pdf"

تفضل الكود .. الأفضل نسخ الكود من داخل الملف المرفق Sub Create_PDF_Files_For_Each_Sheet() Dim Ws As Worksheet Dim Fname As String Application.ScreenUpdating = False For Each Ws In ActiveWorkbook.Worksheets On Error Resume Next Fname = ThisWorkbook.Path & "\Exported " & Ws.Name Ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False Next Ws Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub

أخي ناصر رحم الله أخاك رحمةً واسعة وأدخله الفردوس الأعلى من الجنة

حدد المطلوب بالضبط ليتمكن الأخوة من الرد في الموضوع بدلاً من الرفع بدون فائدة .. وضح بالصور واجعل المطلوب شيء واحد فقط مع وضع بعض النتائج المتوقعة .. حدد أوراق العمل المطلوب العمل عليها والنطاقات والخلايا إلخ ...التفاصيل مهمة

إذا كنت تقصد عمل مجلد يتم التصدير إليه فقم بإنشاء مجلد في نفس مسار الملف باسم Exported وغير السطر التالي في الكود sNewFilePath = ThisWorkbook.Path & "\Exported\Exported.pdf"

لم أفهم المطلوب ..

وعليكم السلام 015-Export Specific Sheets To One PDF File YasserKhalil.rar

حمل الملف التالي فيه ما تطلب https://www.file-upload.com/7qfl4h0vguh9

Private Sub UserForm_Activate() Dim i As Integer For i = 1 To 20 Me.Controls("label" & i).Caption = Range("l" & i + 2) Me.Controls("label" & i + 10).Caption = Evaluate(Application.WorksheetFunction.SumIf(Range("B2:B21"), Me.Controls("label" & i).Caption, Range("C2:C21"))) Next i End Sub

تحديد رقم آخر صف فإذا كان يساوي 7 تظل قيمة آخر صف 7 أما خلاف ذلك فيجلب رقم آخر صف ..

بارك الله فيك أخي سليم ..حل جميل وممتاز لي تعليق بسيط بخصوص استخدام الحلقات التكرارية مرتين .. لما لا يتم عمل حلقة تكرارية واحدة فقط بهذا الشكل Private Sub UserForm_Activate() Dim i As Integer For i = 6 To 10 Me.Controls("label" & i - 5).Caption = Range("l" & i - 3) Me.Controls("label" & i).Caption = Evaluate(Application.WorksheetFunction.SumIf(Range("B2:B11"), Me.Controls("label" & i - 5).Caption, Range("C2:C11"))) Next i End Sub