محمد فاروق محمود قام بنشر أغسطس 10, 2017 مشاركة قام بنشر أغسطس 10, 2017 ارجو من حضراتكم مساعدتى بمعادلات لنقل القيم الاكبر من الصفر من الصفحة 1 والصفحة 2 للصفحة 3 ولكم جزيل الشكر نقل القيم الاكبر من الصفر من صفحة الاولى والثانية للصفحة الثالثة.rar 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 10, 2017 مشاركة قام بنشر أغسطس 10, 2017 ربما يكون الحل هنا الملف مرفق استعمل هذا الكود Option Explicit Sub Give_Data() Dim Target_sheet As Worksheet Dim sh1, sh2 As Worksheet Dim lr1%, lr2%, lr3%, x% Dim my_rg As Range Application.ScreenUpdating = False Set Target_sheet = Sheets("3") Set sh1 = Sheets("1"): Set sh2 = Sheets("2") lr1 = sh1.Cells(Rows.Count, 1).End(3).Row lr2 = sh2.Cells(Rows.Count, 1).End(3).Row Target_sheet.Range("a1").CurrentRegion.ClearContents With sh1 Set my_rg = .Range("C3:C" & lr1).SpecialCells(2, 23) my_rg.Offset(0, -2).Copy Target_sheet.Range("a1") my_rg.Offset(0, 0).Copy Target_sheet.Range("b1") my_rg.Offset(0, 2).Copy Target_sheet.Range("c1") End With lr3 = Target_sheet.Cells(Rows.Count, 1).End(3).Row With sh2 Set my_rg = .Range("C4:C" & lr2).SpecialCells(2, 23) my_rg.Offset(0, -2).Copy Target_sheet.Range("a" & lr3 + 1) my_rg.Offset(0, 0).Copy Target_sheet.Range("b" & lr3 + 1) my_rg.Offset(0, 2).Copy Target_sheet.Range("c" & lr3 + 1) End With lr3 = Target_sheet.Cells(Rows.Count, 1).End(3).Row For x = lr3 To 2 Step -1 If Target_sheet.Cells(x, 2) = 0 Then Target_sheet.Cells(x, 1).Resize(1, 3).Delete Shift:=xlUp Next Application.ScreenUpdating = True End Sub copy_Positives.rar رابط هذا التعليق شارك More sharing options...
محمد فاروق محمود قام بنشر أغسطس 10, 2017 الكاتب مشاركة قام بنشر أغسطس 10, 2017 هذا كود احترافى جزاك اللة كل الخير ولكن هل هناك معادلات تؤدى المطلوب ولك جزيل الشكر رابط هذا التعليق شارك 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.