أبو حنــــين

مشكور اخي الكريم : / الاستاذ أحمد عطيه على مروركم الطيب جزاكم الله خيرا

الشرح صحيح اخي سعد و ممتاز لكنني أريد زيادة تويضيح الجزئية التالية ان اللصق يبتدأ من الصف 5 في الورقة الثانية لاننا قلنا : x = 5 بمعني لو قلنا : x = 10 لبدأ الصق من الصف 10 و الفكرة التي اريد توصيلها انه لا علاقة بين العدد 6 في السطر For i = 6 To LR مع العدد 5 في السطر x = 5 فالاول ( 6 ) خاص بصف النسخ و الثاني ( 5 ) خاص بصف الصق رغم انك ذكرت ذلك في الشرح لكنني اعدته لتتضح الرؤيا لانني وقعت سهوا في هذا الخطأ و قام بتصحيحه اخونا ابو احمد جزاك الله خيرا أخي سعد على الشرح

ضع هذه الدالة في الخلية C4 =IF(or(A4="";B4="");"";SUM(B4/A4))

و جزاك الله خيرا أخي : / سعد عابد و الشكر موصول لاخونا ابو احمد لتصحيحه الخطأ

العفو أخي

اخي بعد اذن الاستاذ يوسف هذا مثال على توليد ارقام عشوائية رقم عشوائي.rar

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

ضع CommandButton في ورقة : حجز النقاط اضف هذا الكود الكود : Private Sub CommandButton1_Click() Dim LR, x LR = [A10000].End(xlUp).Row ورقة3.Range("A5:Q690").Value = "" Application.ScreenUpdating = False x = 5 For i = 11 To LR If Cells(i, 17).Value >= 9 And Cells(i, 17).Value < 10 Then Range("a" & i).Resize(1, 17).Copy ورقة3.Range("A" & x).PasteSpecial xlPasteValues Application.CutCopyMode = False x = x + 1 End If Next i MsgBox "ثم ترحيل البيانات بنجاح", vbInformation + vbMsgBoxRight, "ترحيل بيانات" Application.ScreenUpdating = True ورقة3.Select End Sub[/size][/b] [b][size=5]

السلام عليكم هل تقصد هكذا تجربة الربط - الطلبات.rar

العفو اخي الكريم

اخي والله الكود عندي يعمل بشكل طبيعي لكن جرب التالي ـ 1 ) كون مجلد و سمه RR و ضع فيه ملغات شرط ان تكتب في الخلية A1 من كل ملف قيمة معينة ـ 2 ) انشأ مجلدا آخر و ضع فيه المجلد السابق ـ 3 ) انشأ ملف اكسل ثم افتحه ـ 4 ) اذهب الى محرر VB ثم اضف موديل و انسخ فيه الموديل التالي : Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" _ (ByVal lpRootPath As String, _ ByVal lpInputName As String, _ ByVal lpOutputName As String) As Long Public Const MAX_PATH = 260 Public Function FindFile(RootPath As String, _ FileName As String) As String Dim lNullPos As Long Dim lResult As Long Dim sBuffer As String On Error GoTo FileFind_Error sBuffer = Space(MAX_PATH * 2) lResult = SearchTreeForFile(RootPath, FileName, sBuffer) If lResult Then lNullPos = InStr(sBuffer, vbNullChar) If Not lNullPos Then sBuffer = Left(sBuffer, lNullPos - 1) End If FindFile = sBuffer Else FindFile = vbNullString End If Exit Function FileFind_Error: FindFile = vbNullString End Function ـ 5 ) اذهب الى صفحة Workbook و افتحها و انسخ الكود الاتالي في الحدث Workbook_Open الكود : Private Sub Workbook_Open() ورقة1.Range("A1:A50").ClearContents Set Files = Application.FileSearch With Files .LookIn = ThisWorkbook.Path + "\RR" .FileName = "*.xls" If .Execute > 0 Then For i = 1 To .FoundFiles.Count ورقة1.Cells(i + 1, 1) = .FoundFiles(i) Next i Else MsgBox "لا يوجد ملفات في المسار" & vbNewLine & ThisWorkbook.Path + "\F", vbInformation, "خطأ" End If End With End Sub ـ 6 ) أنشأ في الصفحة الاولى من الملف زر و قم بنسخ الكود التالي في هذا الزر : Private Sub CommandButton1_Click() LastRow = Cells(Rows.Count, "D").End(xlUp).Row '+ 1 On Error Resume Next Dim xl As New Excel.Application Dim xlw As Excel.Workbook Dim Vr As String Vr = ThisWorkbook.Path & "\RR" For n = 1 To 10 Set xlw = xl.Workbooks.Open(Cells(n + 1, 1)) xlw.ورقة1.Range("A1").Select Cells(LastRow + n, 4).Value = xlw.Application.Range("A1").Value xlw.Close False Next LR = Cells(Rows.Count, "D").End(xlUp).Row For t = 1 To LastRow s = LR Cells(1, 5).Formula = "=Sum(D1:D" & s & ")" Next End Sub الآن احفظ الملف في المجلد الثاني الذي أنشأته و اخرج منه ثم اعد فتحه من جديد فإن وجدت في الصفحة الاولى اسماء الملفات التي وضعتها في المجلد RR فالعمل صحيح ما بقي الا الضغط على الزر و ان لم تجد . . . . . . . فالله اعلم بالخطأ الذي وقع

السلام عليكم على افتراض ان الصف المعني بالتغيير هو Range("K2:K34") فيكون الكود كالتالي : Private Sub Worksheet_Selectionchange(ByVal Target As Range) Dim c As Range For Each c In Range("K2:K34") With c If Right(.Text, 2) = "00" Or .Value = 0 Then .NumberFormat = "General" Exit Sub Else .NumberFormat = "0.00" End If End With Next End Sub

السلام عليكم بالنسبة للسؤال الاول ضع في بداية الكود الذي توقف عنده البرنامج الجملة التالية : On Error Resume Next بالنسبة للجمع انا عندي البرنامج يجمع العدد الموجود في الخلية A1 في كل الملفات الموجودة في المجلد المسمى RR بالنسبة للسؤال الثاني فهو يقوم بجمع 10 ملفات فقط لاننا وضعنا الشرط : For i = 1 To .FoundFiles.Count و عندما نريد اكثر من 10 نغير العدد 10 الى اي عدد تريد ملاحظة من المفروض انك عندما تفتح البرنامج تجد ان الخلايا من A2 و اكبر تحتوي على اسماء الملفات الموجودة في المجلد السابق و ان لم تجدها فهناك خطأ ما انا اعمل على اوفيس 2003 و لا ادري ان كان الكود يعمل على اصدار اكبر او لا تحياتي اخي

السلام عليكم اخي هذا الكود يحذف الاسماء او الارقام المتشابهة ثم يمسح الفراغات للمحافظة على الترتيب لكن يحذف الارقام المتشابهة مثلا في العمود A من 1 الى 1000 و هو في هذه الحالة يستغرق حوالى دقيقة فان كان كما ذكرت حذف المتشابه لـ 40000 فربما يستغرق وقتا طويلا لكبر القائمة و لا ادري ان كان هناك كود يستغرق وقت اقل و الله اعلم Private Sub CommandButton1_Click() Dim m, R For Each R In Range("A2:A1000") For m = 1 To 1000 If R.Offset(m, 0).Value = Cells(m, 1).Value Then R.Offset(m, 0).ClearContents End If: Next Next LR = [A1000].End(xlUp).Row For i = LR To 2 Step -1 If Cells(i, 1) = "" Then Rows(i).Delete Shift:=xlUp End If: Next End Sub

اخي ارفق مثالا للعمل عليه

السلام عليكم لرفع الملف قم بضغطه ببرنامج ضغط مثل WinRAR ثم ارسله

If Range("C12:F25").Value = 0 Then MsgBox "بيانات الفاتورة فارغة" Exit Sub End If

السلام عليكم هناك ملف اسمع Book5 و هو الملف الرئيسي و عناك مجلد اسمه RR يحتوي على ملفات كب في الخلية A1 من ك ملف العدد 1000 عند فتح الملف الرئسي تصغط على احسب يقوم بجلب البيانات من هذه الخلية ثم يجمعها في الخلية E1 مثال.rar

شكرا أخي الحبيب : / فهد

العفو أخي : / يوسف

لو أرسلت ملفا لكان اسهل على الاخوة لكن جرب هذه المحاولة Book1.rar

العفو أخي : / مرعى السيد

تفضل اخي تقرير البيع والتحصيل للشركتين.rar

السلام عليكم عند فتح الشيت يظهر مؤاثرات صوتية.rar

اخي عبد الله عندما اضع الكود كما ذكرت : ActiveCell.EntireRow.Delete xlUp يحذف الصف ما قبل الخلية النشطة اما بالكود الذي في الملف يحذف بطريقة عادية و لا اعرف السبب ارجو منك ان تتأكد بنفسك واحدف مثلا الاسم 5 سيحذف انظر المرفق 1.rar