حسونة حسين

وعليكم السلام ورحمة الله وبركاته تفضل اخى الكريم Option Explicit Sub Test() Dim WB As Workbook, WS As Worksheet, SH As Worksheet, sFile As String Application.ScreenUpdating = False Set WS = ThisWorkbook.Worksheets("ورقة1") sFile = ThisWorkbook.Path & "\" & "العملاء.xlsm" Set WB = Workbooks.Open(sFile, False) For Each SH In WB.Worksheets If SH.Name = WS.Cells(2, 3).Value Then WS.Cells(3, 3).Value = SH.Range("H2").Value Next SH WB.Close SaveChanges:=True Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمة الله وبركاته ضع هذا الكود في ملفك وشغله ستجد ملف باسم ملف REEL_DATA_OF_NOVEMBER_2021.Xlsb بجوار ملفك Sub Total() Dim ws As Worksheet, temp As Variant, arr As Variant, F As Boolean, lr As Long Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Total" And ws.Name <> "SUMMARY" And ws.Name <> "TIME" And ws.Name <> "HOLD" Then temp = ws.Range("A6:S" & ws.Cells(Rows.Count, 2).End(xlUp).Row).Value2 If F Then Dim I As Long, ii As Long, ub As Long ub = UBound(arr, 1) arr = Application.Transpose(arr) ReDim Preserve arr(1 To UBound(arr, 1), 1 To ub + UBound(temp, 1)) arr = Application.Transpose(arr) For I = LBound(temp, 1) To UBound(temp, 1) For ii = 1 To UBound(temp, 2) arr(ub + I, ii) = temp(I, ii) Next ii Next I Else arr = temp F = True End If End If Next ws If Not Evaluate("isref('" & "Total" & "'!A1)") Then Sheets.Add.Name = "Total" With Sheets("Total") .Range("A2:S65536").ClearContents .Range("A1").Resize(1, 19).Value = Array("V", "HH", "J", "K", "L", "DD", "HH", "K", "L", "P", _ "GG", "S", "DF", "GH", "HJ", "KJ", "FGH", "G", "Remarks") .Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr With .Range("A1:S" & .Cells(Rows.Count, 2).End(xlUp).Row) .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .RowHeight = 15 ActiveWindow.Zoom = 75 .EntireColumn.AutoFit .Borders.Value = 1 End With End With ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "REEL_DATA_OF_NOVEMBER_2021", FileFormat:=xlExcel12 Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True End Sub

وعليكم السلام ورحمة الله وبركاته جرب هذا التعديل اخى الكريم Private Sub CommandButton2_Click() 'Declare Variables Dim FSO Dim sFile As String Dim sSFolder As String Dim sDFolder As String 'This is Your File Name which you want to Copy sFile = TextBox1.Text 'اكتب الموقع المتواجد فيه الملفات التى تريد نسخها sSFolder = "D:\" 'Change to match the destination folder path sDFolder = ComboBox1.Value 'Create Object Set FSO = CreateObject("Scripting.FileSystemObject") 'Checking If File Is Located in the Source Folder If Not FSO.FileExists(SFolder & sFile) Then MsgBox "Specified File Not Found", vbInformation, "Not Found" 'Copying If the Same File is Not Located in the Destination Folder ElseIf Not FSO.FileExists(sDFolder & Dir(sFile)) Then FSO.CopyFile sFile, sDFolder, True MsgBox "Specified File Copied Successfully", vbInformation, "Done!" Else MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists" End If End Sub

وجزاكم مثله اخى الكريم آمين يارب العالمين وإياكم اخى والحمد لله الذي بنعمته تتم الصالحات

تفضل اخى وعذرا لانى اعمل على الهاتف With WS.AutoFilter.Sort .SortFields.Clear .SortFields.Add Key:=Range("b3"), Order:=xlAscending .Apply End with Application.ScreenUpdating = True

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

قبل هذا السطر في الكود ( الكود في مشاركتى ) Application.ScreenUpdating = True ضع هذه السطور WS.AutoFilter.Sort.SortFields.Clear: .SortFields.Add Key:=Range("b3"), Order:=xlAscending: .Apply ليصبح لكود هكذا WS.AutoFilter.Sort.SortFields.Clear: .SortFields.Add Key:=Range("b3"), Order:=xlAscending: .Apply Application.ScreenUpdating = True

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

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

اخى الكريم التواريخ في ملفك ليست صيغه تواربخ 1\11\2021 لابد ان بكون صبغه تاريخ صحيحه 01/11/2021

اخى الكريم من الذي تحدث عن ترتيب الفواتير هو احنا اتفقنا على كده من بدايه موضوعك لم تتحدث عن اي ترتيب كده هنزعل من بعض ولا ايه وكمان اين هى هذه التواريخ

ملف الاكسل سوف يكون به ٣ شيتات فقط كل هذه ال ٦٠٠٠ فاتورة نكون في شيت واحد هذا الشيت الواحد اسمه (data) يكون السطر البيان الاول من ببانات الفاتورة والسطر الثاني يكون البيان الثانى من الفاتورة وهكذا الى انتهاء الفاتورة ثم الفاتورة التاليه في السطر الذي يليه وهكذا الى انتهاء الفواتير ويكون شيت ثانى باسم search يكون به شكل الفاتورة التى صممتها وهذا التصميم ياخذ بيانته من صفحه (data) اوتوماتيكى وشيت ثالث يكون به ملخص الفواتير

اخى الكريم لتشغيل الكود اضغط Alt+F11 ستجد modules ستجد module1 اضغط في اي سطر بها ثم اضغط F5 او يمكنك عمل ذر وربطه بالكود

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

تمام كده مظبوط هل وضعت هذه الفاتورة الثالثه في نفس الفولدر الذي ارسلته لك في الملف المضغوط أم ماذا صنعت هل هذه الفاتورة ضمن الفولدر الذي في ملف المضغوط ام في مكان اخر اخى الكريم الكود به اسم الفولدر هو ( فواتير ) كما بالصورة التاليه كل ما هو بفولدر فواتير بمجرد تشغيل الكود سوف يجلبه لك اخى الكريم

وعليكم السلام ورحمة الله وبركاته تفضل اخى الكريم طلبك ان شاء الله Monthly Summery.zip

اخى الكريم جرب هذا المعادله =IFERROR(INDEX(BLF!$B$2:$B$7684;SMALL(IF(BLF!$A$2:$A$7684=$C$7;IF(BLF!$D$2:$D$7684=$F$10;IF(BLF!$F$2:$F$7684="P";(ROW($A$2:$A$300)-ROW($A$2)+1);"what is the value you want for false")));ROWS($C$13:C13)));"") ضع مكان هذه العباره "what is the value you want for false" ضع جواب الشرط لو كانت النتيجة false ولو مش عايز تكتب فيها شرط تفضل هذه المعادله =IFERROR(INDEX(BLF!$B$2:$B$7684;SMALL(IF(BLF!$A$2:$A$7684=$C$7;IF(BLF!$D$2:$D$7684=$F$10;IF(BLF!$F$2:$F$7684="P";(ROW($A$2:$A$300)-ROW($A$2)+1))));ROWS($C$13:C13)));"")

وعليكم السلام ورحمة الله وبركاته الملف يفتح بدون طلب رقم سري

اقفل الملف اللى انت شايف كتابته غريبه (ملف pdf ) بدون حفظ واستخدم هذا الكود Private Sub Command1_Click() Dim strFile As String strFile = Application.GetOpenFilename() Textbox5.txt = strFile End Sub

وعليكم السلام ورحمة الله وبركاته تفضل هذا الموضوع به شرح مستفيض لما تريد للاستاذة ساجده

وعليكم السلام ورحمة الله وبركاته جرب هذا الكود اخى الكريم Private Sub Command1_Click() Dim strFile As String strFile = Application.GetOpenFilename() Workbooks.Open (strFile) Textbox5.txt = strFile End Sub

وعليكم السلام ورحمة الله وبركاته استبدل هذه الجمله ThisWorkbook.Path & "\" الى "E:\"

وعليكم السلام ورحمة الله وبركاته لا تدعم جداول بيانات في جوجل vba ما يدعمه تطبيق "جداول البيانات" هو عمل وظائف جافا سكريبت مثل وحدات الماكرو. تحقق من ذلك لمزيد من المعلومات حول وحدات ماكرو جافا سكريبت هنا

اخى الكريم هذا الفيديو للاستاذة ساجده يوضح لك كيف وضع علامه مائيه في الاكسل رابط الفيديو هنا والعلامه المائيه الخاصه بالملف pdf

السلام عليكم ورحمة الله وبركاته يمكنك الاستفادة من هذا الموضوع