أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
ashraf_hertlion hassona229-- لا تميز خلال هذه الفترة YasserKhalil مطلوب تعديل الكود للطباعة اكسيل اسئله واجابات


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





محتاج كود لجمع الشيتات في شيت واحد

السلام عليكم .. من فضلكم عايزكود لتجميع الشيتات ( 1و2و3و4 وهناء و مني ) في شيت ( مجمع شيتات) مع الاحتفاظ بالشيتات الأخ ..


موضوع مغلق


16-09-2021 08:29 مساء
saad mohamed
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 08-08-2019
رقم العضوية : 14161
المشاركات : 78
الجنس : ذكر
تاريخ الميلاد : 12-5-1973
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 65
 offline 

السلام عليكم .. من فضلكم



عايزكود لتجميع الشيتات ( 1و2و3و4 وهناء و مني ) في شيت ( مجمع شيتات) مع الاحتفاظ بالشيتات الأخري



وياريت اسمي هذه الشيتات في الكود .. ولكم جزيل الشكر ووافر الاحترام



hank you very much and much respect


 









 
 
  ايمن.xlsx   تحميل xlsx مرات التحميل :(18)
الحجم :(4155.768) KB



أفضل إجابة مقدمة من ابراهيم الحداد وهي:
السلام عليكم ورحمة الله
استخدم هذا الكود

Sub ColllectShets()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, x As Long
Dim Arr, i As Long
Set ws = Sheets("مجمع شيتات")
Application.ScreenUpdating = False
ws.Range("A3:O10000").Clear
For Each Sh In Sheets(Array("1", "2", "3", "4", "هناء", "مني"))
x = WorksheetFunction.CountA(Sh.Range("B3:B" & Sh.Range("B" & Rows.Count).End(3).Row))
Sh.Range("A3:O" & Sh.Range("B" & Rows.Count).End(xlUp).Row).Copy
If LR < 2 Then
LR = 2
Else
LR = ws.Range("C" & Rows.Count).End(xlUp).Row
End If
ws.Range("A" & LR + 1).PasteSpecial xlPasteFormats
ws.Range("A" & LR + 1).PasteSpecial xlPasteValues
ws.Range("O" & LR + 1).Resize(x).Value = Sh.Name
Application.CutCopyMode = False
For i = 3 To ws.Range("B" & Rows.Count).End(3).Row
ws.Range("A" & i) = i - 2
Next i
Next Sh

Application.ScreenUpdating = True
End Sub

عرض الإجابة




17-09-2021 12:23 صباحا
مشاهدة مشاركة منفردة [1]
ابراهيم الحداد
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 237
الجنس : ذكر
الدعوات : 4
يتابعهم : 0
يتابعونه : 34
قوة السمعة : 2349
عدد الإجابات: 31
 offline 
look/images/icons/i1.gif محتاج كود لجمع الشيتات في شيت واحد
السلام عليكم ورحمة الله
استخدم هذا الكود

Sub ColllectShets()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, x As Long
Dim Arr, i As Long
Set ws = Sheets("مجمع شيتات")
Application.ScreenUpdating = False
ws.Range("A3:O10000").Clear
For Each Sh In Sheets(Array("1", "2", "3", "4", "هناء", "مني"))
x = WorksheetFunction.CountA(Sh.Range("B3:B" & Sh.Range("B" & Rows.Count).End(3).Row))
Sh.Range("A3:O" & Sh.Range("B" & Rows.Count).End(xlUp).Row).Copy
If LR < 2 Then
LR = 2
Else
LR = ws.Range("C" & Rows.Count).End(xlUp).Row
End If
ws.Range("A" & LR + 1).PasteSpecial xlPasteFormats
ws.Range("A" & LR + 1).PasteSpecial xlPasteValues
ws.Range("O" & LR + 1).Resize(x).Value = Sh.Name
Application.CutCopyMode = False
For i = 3 To ws.Range("B" & Rows.Count).End(3).Row
ws.Range("A" & i) = i - 2
Next i
Next Sh

Application.ScreenUpdating = True
End Sub




الكلمات الدلالية
محتاج ، لجمع ، الشيتات ، واحد ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 06:25 مساء