نسخ اعمدة بالعكس

[هاني بدر]

السلام عليكم ورحمة الله وبركاته

الاخوة الكرام لي طلب اعلم انه بسيط ان شاء الله

في المرفق المطلوب نسخ بيانات صفحة الى اخرى بشرطين اولهم عكس الاعمدة وثانيهم وجود بيانات غير صفرية

تقبلوا تحياتي

 

Test_Opisit.zip

[عبدالله باقشير]

السلام عليكم

جرب هذا

Sub KH_START()
Dim Last1 As Long, Last2 As Long
With ورقة2
    Last1 = .Range("A" & .Rows.Count).End(xlUp).Row
    For R = 11 To Last1
        If Val(.Cells(R, "C")) + Val(.Cells(R, "D")) Then
            Last2 = ورقة1.Range("A" & .Rows.Count).End(xlUp).Row + 1
            ورقة1.Cells(Last2, "A").Value = .Cells(R, "B").Value
            ورقة1.Cells(Last2, "B").Value = .Cells(R, "A").Value
        End If
    Next
End With
End Sub

 او هذا

Sub KH_START()
Dim Last1 As Long, Last2 As Long
With ورقة2
    Last1 = .Range("A" & .Rows.Count).End(xlUp).Row
    For R = 11 To Last1
        If Val(.Cells(R, "C")) + Val(.Cells(R, "D")) Then
            Last2 = ورقة1.Range("A" & .Rows.Count).End(xlUp).Row + 1
            ورقة1.Cells(Last2, "A").Value = .Cells(R, "B").Value
            ورقة1.Cells(Last2, "B").Value = .Cells(R, "A").Value
            ورقة1.Cells(Last2, "C").Resize(1, 2).Value = .Cells(R, "C").Resize(1, 2).Value
            ورقة1.Cells(Last2, "E").Value = Val(.Cells(R, "C")) - Val(.Cells(R, "D"))
        End If
    Next
End With
End Sub

تحياتي

[احمد فضيله]

اخي الحبيب الاستاذ العلامه / عبد الله باقشير

 

جزاك الله عنا خير الجزاء

و جعلك الله دوما عونا للمسلمين

[عبدالله باقشير]

السلام عليكم

اخي الحبيب  / احمد فضيلة....حفطكم ربي

اسعدني مروركم الطيب

جزاكم الله خيرا وبارك فيكم

 

تقبلوا تحياتي وشكري

[هاني بدر]

السلام عليكم ورحمة الله وبركاته

اخي المبدع عبدالله باقشير بالفعل هذا هو المطلوب اشكرك جزيلا على سرعة استجابتك وهذا هو المنتظر من اناس يعجز اللسان عن وصف مابهم من مكارم الاخلاق

تقبل تحياتي ودعائي الذي لا ينقطع لك ولكل من ساهموا في تقدم ورقي هذا المنتدى العظيم