ترحيل بيانات بكود VBA

[أبو ليمونه]

السلام عليكم

احتاج الى مساعدتكم بتعديل الكود التالي :
 

Sub CopyPriceOver()
If Range("A1").Value > Range("B1").Value Then
Sheet1.Range("A1").Copy
Sheet1.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
	 :=False, Transpose:=False
	 Application.CutCopyMode = False
Calculate
Calculate
ElseIf Range("A1").Value < Range("C1").Value Then
Sheet1.Range("A1").Copy
Sheet1.Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
	 :=False, Transpose:=False
	 Application.CutCopyMode = False
Calculate
Calculate
End If
Call ScheduleCopyPriceOver
End Sub

ما اريد عمله هو التالي

اذا القيمة في الخلية A1 اكبر من القيمة في الخلية B1 فيقوم بنسخ القيمة من A1 الى B1
و اذا القيمة في الخلية A1 اصغر من القيمة في الخلية C1 فيقوم بنسخ القيمة من A1 الى C1

خلية A1 خلية متغيرة فالغرض من الكود هو استخراج اعلى قيمة سجلتها الخلية A1 واستخراج اصغر قيمة سجلتها الخلية A1

اريد الكود ان يقوم بتطبيق العملية على الخلايا A1:A100
فينظر بكل خلية من A1 الى A100 اذا اي خلية في A اكبر من الخلية B يقوم بنسخها الى B
واذا اي خلية في A اصغر من الخلية C يقوم بنسخها الى C

مثال للتوضيح فقط:
نفترض ان الخلية A79 اكبر من الخلية B79 فيجب ان يقوم الكود بنسخ A79 الى B79
نفترض ان الخلية A88 اصغر من الخلية C88 يقوم بنسخ خلية A88 الى الخلية C88
نفترض ان الخلية A45 اصغر من الخلية B45 لا يقوم بالنسخ ولا بمسح الخلية B45 لانها اصغر من A45 وليست اكبر
نفترض ان الخلية A99 تساوي B99 او C99 لا يقوم بعمل شي ولا يمسح B99 و C99


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

Test.zip

[أبو حنــــين]

قم بإضافة زر و اكتب الكود التالي

Private Sub CommandButton1_Click()

For t = 1 To 100

If Val(Cells(t, 1).Value) > Val(Cells(t, 2).Value) Then

Cells(t, 2).Value = Val(Cells(t, 1).Value)

ElseIf Val(Cells(t, 1).Value) < Val(Cells(t, 3).Value) Then Cells(t, 3).Value = Val(Cells(t, 1).Value)

ElseIf Val(Cells(t, 1).Value) < Val(Cells(t, 2).Value) Then Exit Sub

ElseIf Val(Cells(t, 1).Value) = Val(Cells(t, 2).Value) Or Val(Cells(t, 1).Value) = Val(Cells(t, 3).Value) Then Exit Sub

End If

Next

End Sub

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

السلام عليكم

Sub kh_Test()

Dim i As Integer

'''''''''''''''''''

For i = 1 To 100

    If Val(Cells(i, "A")) > Val(Cells(i, "B")) Then

        Cells(i, "B").Value = Cells(i, "A").Value

    End If

    '''''''''''''

    If Val(Cells(i, "A")) < Val(Cells(i, "C")) Then

        Cells(i, "C").Value = Cells(i, "A").Value

    End If

Next

'''''''''''''''''''

End Sub

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

اخي الحبيب ابو حنين

عفوا

فقط

زيادة في الخير

[أبو حنــــين]

الله يكرمك اخي عبد الله

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

و كما قلت زيادة الخير من الأخيار خيرين

[أبو ليمونه]

الاستاذ ابو حنين

شكرا لك على المساعده الكود يعمل ....

ربي يكرمك ويزيدك خير

الاستاذ عبدالله

اشكرك من اعماق قلبي الكود يعمل ....

ربي يوفق بالدنيا والاخرة

تحياتي لكم