مطلوب نسخ البيانات من ورقة الى ورقة بشرط

[الشافعي]

نسخ بيانات ورقة عرض مبدئي الى ما يمثلها في ورقة العملاء وعند تغير بيانات العرض المبدئي تنسخ البيانات الجديدة في صف جديد تحت التى نسخت من قبل 

aaaaaaaaaaaaa.rar

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

السلام عليكم

 

جرب الكود التالي

Sub kh_Start()
Dim v, vv
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Lr As Integer, i As Integer

Set Sh1 = Sheets("عرض مبدئي")
Set Sh2 = Sheets("العملاء")

vv = Array("c11", "H12", "", "J14", "J16", "c12", "j18", "j20", "j22", "j44", "j48", "j32", "j38", "j36", "j34", "j40", "j522", "j50", "j54", "j56")

Lr = Sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each v In vv
    i = i + 1
    If Not IsError(Sh1.Evaluate(v)) Then
        Sh2.Cells(Lr, i).Value = Sh1.Range(v).Value
    End If
Next

Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

المرفق 2003

aaaaaaaaaaaaa.rar

 

تحياتي

[فضل حسين]

العلامة الكبير / عبدالله باقشيير

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

نريد ان نستمتع بأعمالك ونسعد بها

نرجو من سيادتك اذا سمحت وتفضلت علينا بنسخة من الملف على اكسل 2003

حتى لانحرم من اعمال الجميلة

ولسيادتكم جزيل الشكر

فضل

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

 

العلامة الكبير / عبدالله باقشيير

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

نريد ان نستمتع بأعمالك ونسعد بها

نرجو من سيادتك اذا سمحت وتفضلت علينا بنسخة من الملف على اكسل 2003

حتى لانحرم من اعمال الجميلة

ولسيادتكم جزيل الشكر

فضل

 

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

جزاكم الله خيرا

تم اضافة النسخة في المشاركة السابقة اعلاه

تحياتي

[فضل حسين]

استاذنا الكبير والعلامة الكبير / عبدالله باقشيير

الف الف شكر وجزاك الله كل خير وزادك الله علم 

[الشافعي]

السلام عليكم

 

جرب الكود التالي

Sub kh_Start()
Dim v, vv
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim Lr As Integer, i As Integer

Set Sh1 = Sheets("عرض مبدئي")
Set Sh2 = Sheets("العملاء")

vv = Array("c11", "H12", "", "J14", "J16", "c12", "j18", "j20", "j22", "j44", "j48", "j32", "j38", "j36", "j34", "j40", "j522", "j50", "j54", "j56")

Lr = Sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each v In vv
    i = i + 1
    If Not IsError(Sh1.Evaluate(v)) Then
        Sh2.Cells(Lr, i).Value = Sh1.Range(v).Value
    End If
Next

Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

المرفق 2003

aaaaaaaaaaaaa.rar

 

تحياتي

 

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

الله يوفقك ويجعله في ميزان حسناتك