محمد نوح قام بنشر ديسمبر 31, 2012 مشاركة قام بنشر ديسمبر 31, 2012 السلام عليكم ورحمة الله وبركاته الاخوه الكرام هذا الكود للاخ الفاضل ابو نصار تم تعديلة بما يتناسب مع عملى ولكن بعد التعديل يوجد مشكلة فى الترحيل حيث يتم اختيار الصفحة المراد الترحيل اليها من عامود البيان وكتابه البيانات المراد ترحيلها فى الصفحة M1 فى الاعمدة باللون الاصفر والبيانات المراد ترحيلها للصفحة M2 فى الاعمدة باللون الرمادى . ارجو المساعدة وجزاكم الله كل الخير...M1.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر ديسمبر 31, 2012 مشاركة قام بنشر ديسمبر 31, 2012 (معدل) السلام عليكم جرب هذا التعديل Public Sub Ali_T() Dim Sh As Worksheet Dim R As Range With Application .ScreenUpdating = False .Calculation = xlCalculationManual For Each Sh In ThisWorkbook.Worksheets If Not Sh.Name = "الكشف الرئيسي" Then For Each R In Range("A4:A500") If Not IsEmpty(R) And R.Text = Sh.Name Then Select Case R.Text Case Is = "M2" R.Offset(0, 23).Resize(1, 7).Copy Sh.Select L_a = Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row If L_a - 1 = 1 Then A = 7 Else A = L_a Sh.Range("A" & A).PasteSpecial xlPasteValues Feuil1.Select L_a = L_a + 1: A = A + 1 Case Is = "M1" R.Offset(0, 1).Resize(1, 22).Copy Sh.Select L_a = Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row If L_a - 1 = 1 Then A = 7 Else A = L_a Sh.Range("A" & A).PasteSpecial xlPasteValues Feuil1.Select L_a = L_a + 1: A = A + 1 End Select End If Next End If Next .ScreenUpdating = True .Calculation = xlCalculationAutomatic .CutCopyMode = False End With Set R = Nothing End Sub تم تعديل ديسمبر 31, 2012 بواسطه عباد رابط هذا التعليق شارك More sharing options...
محمد نوح قام بنشر ديسمبر 31, 2012 الكاتب مشاركة قام بنشر ديسمبر 31, 2012 اخى الكريم ابو نصار جزاك الله خيرا على الرد السريع وجعله الله سبحانه وتعالي فى ميزان حسناتك ان شاء الله سوف اجرب هذا الكود واتمنى من الله ان يفى بالغرض مع خالص تمنياتى بالتوفيق رابط هذا التعليق شارك 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.