إبراهيم ابوليله

اخى اسامه يمكنك استعمال هذا الكود الكود يقوم بعمل نسخه بتاريخ اليوم بمعنى انه اذا قمت فتح الملف وغلقه اكثر من مره فى اليوم فلن تجد غير نسخه واحه لهذا اليوم كل مره يتم غلق الملف فيها يتم حزف النسخه الموجوده بتاريخ اليوم وتسجيل نسخه جديده وهكذا بالنسبه لليوم الذى يليه Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim BOOKNAME As String BOOKNAME = ThisWorkbook.Name & "--" & Format(Date, "DD-MM-YYYY") ThisWorkbook.SaveAs ("C:\Users\hima\Desktop\" & BOOKNAME & ".XLSB") End With End Sub واذا اردت الاحتفاظ بنسخه واحده فقط دون الحاجه الى التاريخ قم بتغير السطر التالى BOOKNAME = ThisWorkbook.Name & "--" & Format(Date, "DD-MM-YYYY") الى BOOKNAME = ThisWorkbook.Name

اخى جرب وضع الكود بالشكل الاتى فى حدث الورك بوك Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim msg As String Dim ans As Integer Dim ahmad As String, hamoor As String ahmad = "c:\ahmad 1\" & ThisWorkbook.Name ThisWorkbook.SaveCopyAs ahmad hamoor = "d:\ahmad 2\" & ThisWorkbook.Name ThisWorkbook.SaveCopyAs hamoor Application.DisplayAlerts = False ThisWorkbook.Save Application.Quit End Sub

اخى عبدالله دائما ما يحتاج المنتدى الى عمل يجدد به حيويه هذا المنتدى ونحن دائما نتعطش الى كل ما جديد منك بارك الله لنا فيكم

اخى قم بوضع هذا الكود فى موديل Option Explicit Sub Mail_Range() 'Working in 2000-2007 Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Set Source = Nothing On Error Resume Next Set Source = Range("A1:e15").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") If Val(Application.Version) < 12 Then 'You use Excel 2000-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 FileExtStr = ".xlsx": FileFormatNum = 51 End If With Dest .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next .SendMail "", _ "This is the Subject line" On Error GoTo 0 .Close savechanges:=False End With Kill TempFilePath & TempFileName & FileExtStr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

اخى واستاذنا شوقى مش عارف اققولك ايه بس يكفيك دعاءى لك بارك الله فيك وذادك من فضله وعلمه ---------------------------------------- الحمد لله تم التوصل الى المطلوب ------------------------------------------- واعتقد الكود سيكون بالشكل الاتى Sub workbookAdd_WITH_COPY() 'ßæÏ ÝÊÍ ãáÝ ÌÏíÏ Dim Wkb As Workbook Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Set ws1 = ThisWorkbook.Sheets("ADD NEW SHEET") Set ws2 = ThisWorkbook.Sheets("ADD NEW WITOUT REPEAT WIHT COPY") Set ws3 = ThisWorkbook.Sheets("OPEN NEW WORKBOOK WITH COPY") Workbooks.add Set Wkb = ActiveWorkbook Wkb.Worksheets(1).Range(ws1.Range("A3:A15").Address).Value = ws1.Range("A3:A15").Value Wkb.Sheets.add after:=Worksheets(Worksheets.Count) Wkb.Worksheets(2).Range(ws2.Range("A3:A15").Address).Value = ws2.Range("A3:A15").Value Wkb.Sheets.add after:=Worksheets(Worksheets.Count) Wkb.Worksheets(3).Range(ws3.Range("A3:A15").Address).Value = ws3.Range("A3:A15").Value ws3.Activate End Sub اخى شوقى اذا كان هناك حل اخر ارجو ارفاقه مشكورا اخى الحبيب

اخى شوقى مشكورا على الرد والاجابة الدقيقه بارك الله فيك ولكن ماذا لو اردنا نقل بيانات الشيت الثالث ايضا كيف سيكون شكل الكود

اخى شوقى بارك الله فيك ولكن هل يمكن الرجوع مره اخرى الى الملف الذى تم اضافته -------------------------------- لاننى بالمعنى الاصح اريد ان اقوم بنسخ البيانات من شيت 1 الى شيت 1 فى الملف الذى تم اضافته ثم نسخ البيانات من شيت 2 الى شيت 2 فى الملف الذى تم اضافته

الاخوه الكرام المطلوب هو انه بعد انشاء ملف جديد ونقل البيانات اليه يتم الرجوع مره اخرى الى الشيت الاصلى WOR.rar

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

اخى ابو عيد اشكرك على المحاوله ولكن الخطأ ماذال موجود

الاخوه الكرام عند غلق الفورم يحث خطأ رقم 380 ارجو المساعده 00.rar ERR.rar

اخى ضاحى هل هناك حل لهذه المشكله

اخى احمد مشكورا عى الاهتمام باساتذتنا الافاضل ------------------------------------------------ اخى واستاذنا رجب انا لله وانا اليه راجعون البقاء لله نسأل الله ان يقها شر فتنه القبر ويخفف عنها العذاب وان يدخلها الجنه بغير حساب وان يخلفكم خيرا على ما صبرتم

اخى واستاذنا عبداله باقشير طبعا مش هقول ان اعمالك تفوق الخيال فانت عملاق هذا المنتدى ولا يوجد شخص لم يتعم ويستفاد منك بارك الله فيك ومشكورا على المساعده ونسأل الله ان يزيدك من فضله وعلمه وان يديم عليك الصحه والعافيه

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

اخى سليم بارك الله فيك ومشكورا على المعلومه الجميله دى شكرا لك

وعليكم السلام ورحمة الله وبركاته اخى سليم مشكورا على الرد ولكن ما فائدة السطر i=3

الاخوه الكرام لدى كود يقوم بحزف الصفوف بناء على تطابق الاسم الموجود فى الخليه B1 مع الاسماء الموجوده فى العمود الاول بدايه من اللخليه A4 ولكن الخطأ انه عند الحزف يحزف الاسماء المتطابقه ما عدا اول اسم ارجو تصحيح الكود ان امكن DEL.rar

اخى ابو حنين اولا اشكرك على الاكواد الجميله الرائعه فكما عودتنا ان نرى فيك البساطه فى الاداء بارك الله فيك وبالفعل هذا ما اريده ولكنى ابحث عن كود يقوم بعمل ذلك دون الحاجه الى وجود عمود تسلسل فهل يوجد كود يقوم بعمل ذلك

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

اخى ابوجيداء وجزاك الله كل خير

اخى اكرم هل تقصد هكذا COUNTIF فورمة.rar

الاخوه الافاضل ارجو المساعده فى كود التعديل على البيانات التى تظهر فى التيكست بوكس بحث وتعديل فى حالة تكرار الكود.rar

اخى سليم جزاك الله خيرا على هذه المعلومات بارك الله فيك

اخى انا جربت الكود شغال تمام