ارجو من حضراتكم المساعدة فى نقل بيانات الاكبر من الصفر من الصفحة الاولى والثانية الى الصفحة الثالثة

[محمد فاروق محمود]

ارجو من حضراتكم مساعدتى بمعادلات لنقل القيم الاكبر من الصفر من الصفحة 1 والصفحة 2 للصفحة 3  ولكم جزيل الشكر

 

نقل القيم الاكبر من الصفر من صفحة الاولى والثانية للصفحة الثالثة.rar

[سليم حاصبيا]

ربما يكون الحل هنا

الملف مرفق

استعمل هذا الكود

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

[محمد فاروق محمود]

هذا كود احترافى جزاك اللة كل الخير ولكن هل هناك معادلات تؤدى المطلوب  ولك جزيل الشكر