عبدالله المجرب

السلام عليكم قمت بعمل كود جديد يعتمد على التصفية المتقدمة حسب شروطك فان لم تكن هناك ورقة عمل بالاسم الموجود في الخلية يتم اضافة ورقة جديدة بهذا الاسم وترحيل البيانات اليها وان كانت موجودة يتم تخييرك ما بين الترحيل من عدمه فان اخترت الترحيل يتم الترحيل اسفل البيانات السابقة Sub Abu_Ahmed_Filter() Set MySh = Sheets("بيانات") shName = [F3] For i = 1 To Sheets.Count If Sheets(i).Name = shName Then Reply = MsgBox("هذه الورقة موجودة مسبقاً" & Chr(10) & "هل تريد ترحيل البيانات اليها على أية حال", vbYesNo, "تنبيه") If Reply = vbYes Then GoTo 1 Exit Sub End If Next Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = shName 1: LR = Sheets(shName).[A10000].End(xlUp).Row + 1 MySh.[B4:N15000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=MySh.[As1:AV2], _ CopyToRange:=Sheets(shName).Range("A" & LR & ":M" & LR), Unique:=False End Sub بيانات.rar

اخي فضل قبل الرد عليك اليكم اخواني الجزء الثاني من الشرح وملف الشرح في المرفقات الترحيل2.rar

هل تقصد هكذا Book1 (3).rar

هذا بسبب اختيار تحديد الصف الاخير الى نفس العمود Cells([B1000].End(xlUp).Row + 1, 2) = TextBox1.Value Cells([c1000].End(xlUp).Row + 1, 3) = TextBox3.Value يمكنك تحديد العمود B فقط هكذا Cells([B1000].End(xlUp).Row + 1, 2) = TextBox1.Value Cells([B1000].End(xlUp).Row + 1, 3) = TextBox3.Value

جربت وللعلم الكود يعمل ولو عايز فيديو حرفق لك

انار الله دربك يا ابا ادم

دالة VLOOKUP

السلام عليكم ماذا تعني هذه vbCrLf

جرب المرفق Book1 (3).rar

احسنت استاذ بن عليه جميل جداً الشرط بعدم خلو الخلية من البيانات

جربت الكود يعمل الكود بالخروج من الملف في حالتين اختيار لا او باسوورد خاطى

جميل البدء وجميل الرد بارك الله فيكم اساتذتنا الكرام

بارك الله فيكم اخواني الكرام على مروركم وتشجيعكم

بإمكانك استخدام هذه الاكواد (2007) في حدث ThisWorkbook لاخفائها عند الفتح واعادتها عند الاعلاق Private Sub Workbook_Open() ActiveWindow.DisplayHeadings = False Application.DisplayFormulaBar = False Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",FALSE)" End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWindow.DisplayHeadings = True Application.DisplayFormulaBar = True Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" End Sub

بإمكانك تجربة هذا الكود Sub Abu_Ahned_Cont() For Each Cl In [B3:B12] w = UBound(Filter(Split(MyArr, ","), Cl)) + 1 If w = 0 Then MyArr = MyArr & Trim(Cl) & "," Next For Each c In Split(MyArr, ",") R = R + 1 Next [B14] = Application.CountA([B3:B12]) [B15] = R - 1 End Sub

لا اعتقد انه يمكن فما رايك بكود في زر أمر

جميل جداً وطريقة مميزة في العرض وخصوصاً انها المشاركة الاولى

جرب هذا الكود بدل الكود السابق Private Sub UserForm_Initialize() TextBox5 = Format(Date, "dd/mm/yyyy") TextBox6 = Time End Sub

اخواني الكرام اضع بين ايديكم الجزء الاول من شرح الترحيل وبإنتظار تعليقاتكم واستفسارتكم ابواحمد الجزء الاول من الشرح ملف شرح الجزء الاول الترحيل.rar الجزء الثاني من الشرح ملف شرح الجزء الثانى الترحيل2.rar الجزء الثالث من الشرح (ترحيل القيم - ترحيل محدوود) ملف شرح الجزء الثالث الترحيل3.rar الجزء الرابع من شروحات الترحيل ملف شرح الجزء الرابع ترحيل حسب اسم الشيت.rar لا تنسوني أخوتي من الدعاء لي بظهر الغيب

تم فصل الموضوع === اليك المرفق غائب.rar

هل الغائب في خانة واحدة ام عدة خانات

ضع مرفق وسيتم فصل الموضوع الى موضوع جديد

جرب المرفق الارتباط التشعبي.rar

يمكن ذلك بالحماية الخاصة للخلايا التي تحوي صيغ