اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كود نقل اسم العميل الى شيت اخر مع عدم تكرار الاسم


إذهب إلى أفضل إجابة Solved by Ali Mohamed Ali,

الردود الموصى بها

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

test 2.xlsm

رابط هذا التعليق
شارك

  • أفضل إجابة

تفضل اخى الكريم -يمكنك استخدام هذا الكود ... تم التعــديــل

من فضلك عليك بأستخدام خاصية البحث بالمنتدى قبل رفع مشاركتك حتى لا يتم اهدار مزيد من الوقت فى موضوعات قد تكررت وتم تناولها عشرات المرات

Sub Test()
Dim rng1 As Range
Dim str_search As String
ThisWorkbook.Sheets("البداية").Activate
str_search = Range("b6").Value
ThisWorkbook.Sheets("التقرير").Activate
Set rng1 = Sheets("التقرير").Range("a:a").Find(str_search, , xlValues, xlWhole)
If rng1 Is Nothing Then
Dim lastRow As Long
lastRow = ThisWorkbook.Sheets("التقرير").Range("A1000000").End(xlUp).Row
lastRow = lastRow + 1
With ThisWorkbook.Sheets("التقرير")
.Range("A" & lastRow).Value = Sheets("البداية").Range("B6").Value
.Range("B" & lastRow).Value = Sheets("البداية").Range("B7").Value
.Range("C" & lastRow).Value = Sheets("البداية").Range("B8").Value
End With
Sheets("البداية").Range("B6").Value = ""
Sheets("البداية").Range("B7").Value = ""
Sheets("البداية").Range("B8").Value = ""
 Else
MsgBox str_search & " موجود مسبقا"
ThisWorkbook.Sheets("البداية").Activate
End If
End Sub

 

test 3.xlsm

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information