ترحيل بيانات ( عنوان معدل )

[أبو زهرة]

السلام عليكم

اريد شرح لترحيل البيانات الى شيتات

المطلوب عمله فى المرفق

ولكم جزيل الشكر

Book1.rar

[بن علية حاجي]

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

السلام عليكم

اريد شرح لترحيل البيانات الى شيتات

المطلوب عمله فى المرفق

ولكم جزيل الشكر

أخي الكريم، المطلوب بعض الشرح حسب ما وضعته في الملف المرفق,,,

 

أخوك بن علية

 

المرفق : Book1.rar

[أبو زهرة]

اشكرك استاذ(بن علية)على الرد.

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

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

Book12.rar

[جمال عبد السميع]

أين البيانات الذى سيتم ترحيلها أو وضعها أسفل القائمة المنسدلة اذا ماتغيرت محتويات القائمة

بياناتك أخى غير مكتملة

تقبل تحياتى

[أبو زهرة]

اشكرك استاذ جمال.

ولكن انا اقصد انى ساقوم بادخال البيانات جديدة فى القائمة ويتم ترحيلها

 

Book15.rar

[جمال عبد السميع]

تفضل أخى

 

ترحيل بيانات 2.rar

[رجب جاويش]

بعد إذن أخى الحبيب / جمال عبد السميع

:fff:

 

هذا كود لترحيل البيانات التى يتم ادخالها

مع مرعاة عدم ترحيل البيانات المكررة

ومسح البيانات المرحلة من الصفحة الأصلية بعد عملية الترحيل

Sub ragab()
Set WF = Application.WorksheetFunction
Application.ScreenUpdating = False
If IsEmpty([B6]) Or IsEmpty([B8]) Or IsEmpty([B9]) Or IsEmpty([B10]) Then
MsgBox "أكمل البيانات أولا"
Exit Sub
End If
On Error Resume Next
x = Trim(Range("B6").Value)
LR = Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1
If WF.CountIf(Sheets(x).Range(Sheets(x).Cells(3, 1), Sheets(x).Cells(LR, 1)), [B8]) >= 1 Then
MsgBox "هذا الإسم مكرر حيث تم ترحيله من قبل"
Exit Sub
End If
Sheets(x).Cells(LR, 1).Resize(1, 3).Value = WF.Transpose(Range("B8:B10").Value)
Range("B8:B10").Value = ""
MsgBox "تم الترحيل بحمد الله"
[B6].Select
Application.ScreenUpdating = True
End Sub

ترحيل إلى عدة صفحات.rar

[أبو زهرة]

أشكرك استاذ جمال واستاذنا رجب جاويش .هذا ما أردته ولكن اريد تعلم كيفية عمل الكود وتشغيله ولكن بالتفصيل لانى مبتدئ ولكم جزيل الشكر