أحمد علي (أبوعلي) قام بنشر مايو 13, 2013 مشاركة قام بنشر مايو 13, 2013 السلام عليكم ورحمة الله وبركاتهأخواني الكرامأشكركم على فتح عقولكم وصدوركم لمن يطلب العلموجزاكم الله ألف خير وييسر أمركم في الدنيا والآآآآآآآآآآآآآخرة .... آآآآآآآآمينعندي سؤال واحد وبعون الله سأجد الحل عندكم ...سؤالي هو هل من الممكن كود أن يرحل بيانات من ورقة في الاكسيل إلى ورقة أخرى في ملف اكسيل آخر ؟ كما أني أرسلت ملف للتطبيقأرجوا الرد وجزاكم الله خير.أخوكمأحمد علي Bjn3000.rar رابط هذا التعليق شارك More sharing options...
أحمد علي (أبوعلي) قام بنشر مايو 15, 2013 الكاتب مشاركة قام بنشر مايو 15, 2013 السلام عليكم ورحمة الله وبركاتهأخواني الكرامأخواني المبرمجين أخوكم طلب مساعدتكم في موضوعه السابق ولم يجد أر رد وللعلم أني عضو جديد ولحبي للأكسيل وسمعتكم الممتازة وتفاعلكم الحسن هذا ما شجعني للأشتراك في المنتدى وطمعي في مساعدتكم لي في حل لمشكلتي أرجوا الرد وجزاكم الله خير.أخوكمأحمد علي رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر مايو 15, 2013 مشاركة قام بنشر مايو 15, 2013 السلام عليكم جرب هذ Sub Macro1() Dim wo1 As Workbook Dim sh1 As Worksheet Dim R As Integer Dim Last As Long '''''''''''''''''''' Set wo = Workbooks("Book2") Set sh = wo.Worksheets("Book2") '''''''''''''''''''' With sh For R = 1 To 35 If WorksheetFunction.CountIf(Range("B8").Cells(R, 1).Resize(1, 6), "<>") = 6 Then Last = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(Last, "A").Value = Range("D5").Value .Cells(Last, "B").Value = Date .Cells(Last, "C").Resize(1, 6).Value = Range("B8").Cells(R, 1).Resize(1, 6).Value End If Next End With '''''''''''''''''''' Set wo = Nothing Set sh = Nothing End Sub المرفق 2010 Bjn3000.rar تحياتي رابط هذا التعليق شارك More sharing options...
أحمد علي (أبوعلي) قام بنشر مايو 19, 2013 الكاتب مشاركة قام بنشر مايو 19, 2013 جزاك الله عني وعن كل من استفاد من المنتدي ألف خير وأشكرك على الجهود التي بذلتها في هذا الملف ولكن يالأستاذ/ عبدالله باقشير الملف تم ترحله ولكن يوجد بعض الشروط لم تتم: 1. خانة Source Number لم تتغير والمطلوب يزيد +1 2. لم يتم مسح البيانات من الجدول في نطاق [b8:G42] بعد الترحيل . والعفو منك، وفي مِيازين حسناتك إن شاء الله أخوك: أحمد علي رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر مايو 19, 2013 مشاركة قام بنشر مايو 19, 2013 السلام عليكم جرب هذا Sub Macro1() Dim wo As Workbook Dim sh As Worksheet Dim R As Integer, RR As Integer Dim Last As Long '''''''''''''''''''' On Error GoTo 1 Set wo = Workbooks("Book2") Set sh = wo.Worksheets("Book2") '''''''''''''''''''' With sh For R = 1 To 35 If WorksheetFunction.CountIf(Range("B8").Cells(R, 1).Resize(1, 6), "<>") = 6 Then Last = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(Last, "A").Value = Range("D5").Value2 .Cells(Last, "A").NumberFormat = "13-00000" .Cells(Last, "B").Value = Date .Cells(Last, "C").Resize(1, 6).Value = Range("B8").Cells(R, 1).Resize(1, 6).Value RR = RR + 1 End If Next End With ''''''''''''''''''''' If RR Then Range("D5").Value2 = Val(Range("D5")) + 1 Range("B8:G42").ClearContents End If '''''''''''''''''''' 1: If Err Then MsgBox Err.Number Set wo = Nothing Set sh = Nothing End Sub تحياتي رابط هذا التعليق شارك More sharing options...
أحمد علي (أبوعلي) قام بنشر مايو 20, 2013 الكاتب مشاركة قام بنشر مايو 20, 2013 السلام عليكم وبارك الله فيك يا أستاذ/ عبدالله ويعطيك عافية على الجهود المبذله أخي الاستاد/ عبدالله الكود الأخير قام بالمطلوب وجزاك الله خير ولكـن ملاحـظ أن الترحيل مرتبط بشرط أن يكون الملف [book2] مفتوحاً طـيب بنسبة لملف [book2] لا أحب أن يفتح مـن قبل المستخدم حتى يرحل هـل من الممكن أن يـتـم تعديل الكود بحيث قبل الترحيل يقوم بفتح الملف ثـم الترحيل وبعدها يقوم بحفظ الملف ثم الإغلاقة والمقصود بالملف [Book2] مع خالص الشكر والتقدير ..... رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر مايو 20, 2013 مشاركة قام بنشر مايو 20, 2013 السلام عليكم جرب هذا Sub Macro1() Dim wo1 As Workbook, wo2 As Workbook Dim sh As Worksheet Dim MyPath As String Dim R As Integer, RR As Integer Dim Last As Long '''''''''''''''''''' On Error GoTo 1 Application.ScreenUpdating = False '''''''''''''''''''' Set wo1 = ThisWorkbook MyPath = wo1.Path & Application.PathSeparator & "Book2.xlsm" Set wo2 = Workbooks.Open(MyPath) Set sh = wo2.Worksheets("Book2") '''''''''''''''''''' wo1.Activate With sh For R = 1 To 35 If WorksheetFunction.CountIf(Range("B8").Cells(R, 1).Resize(1, 6), "<>") = 6 Then Last = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(Last, "A").Value = Range("D5").Value2 .Cells(Last, "A").NumberFormat = "13-00000" .Cells(Last, "B").Value = Date .Cells(Last, "C").Resize(1, 6).Value = Range("B8").Cells(R, 1).Resize(1, 6).Value RR = RR + 1 End If Next End With ''''''''''''''''''''' If RR Then Range("D5").Value2 = Val(Range("D5")) + 1 Range("B8:G42").ClearContents End If '''''''''''''''''''' 1: wo2.Close True Application.ScreenUpdating = True If Err Then MsgBox Err.Number Set wo1 = Nothing Set wo2 = Nothing Set sh = Nothing End Sub تحياتي 2 رابط هذا التعليق شارك More sharing options...
محمود رواس قام بنشر مايو 20, 2013 مشاركة قام بنشر مايو 20, 2013 ماشاء الله تبارك الله استاذنا ومعلمنا الفاضل عبدالله باقشير الله يزيدك من علمه وفضله وان شاء الله نستفيد من علمك . رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر مايو 20, 2013 مشاركة قام بنشر مايو 20, 2013 ماشاء الله تبارك الله استاذنا ومعلمنا الفاضل عبدالله باقشير الله يزيدك من علمه وفضله وان شاء الله نستفيد من علمك . جزاكم الله خيرا تقبلوا تحياتي وشكري رابط هذا التعليق شارك More sharing options...
أحمد علي (أبوعلي) قام بنشر مايو 21, 2013 الكاتب مشاركة قام بنشر مايو 21, 2013 السلام عليكم ورحمة الله وبركاته أخي الأستاذ/ عبدالله باقشير جزاك الله خير وبارك فيك وزادك في العلم آمين رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.