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

[محمد ابو ضيف]

السلام عليكم

 

الأخوه الكرام اعضاء منتدى اوفيسنا

 

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

واطمع فى مساعدتكم لى فى المطلوب

 

اريد تنفيذ ماكرو للترحيل عن طريق زر بالشروط الاتيه:

 

الترحيل من شيت Received shipments الى شيت shipments

ترحيل كل عمود الى ما يقابله فى الشيت الأخر حسب اسم العمود معادا العمود Description لا اريد ترحيله

وان يتم مسح البيانات التى تم ترحيلها لأنها سوف تستلم شحنات غيرها

شرط الترحيل:

ان يتم ترحيل ارقام شحنات معينه والموجوده فى العمود invoice No,

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

 

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

Alex Stock.rar

[عاشق الاكسيل]

دخل رقم الفاتورة فى الخلية D2 ودوس على Get Data

لعله المطلوب ( انا عدلت على ترتيب الاعمدة)

 

Alex Stock.rar

[محمد ابو ضيف]

2 ساعات مضت, عاشق الاكسيل said:

دخل رقم الفاتورة فى الخلية D2 ودوس على Get Data

لعله المطلوب ( انا عدلت على ترتيب الاعمدة)

 

Alex Stock.rar

ا/ عاشق

 

شكرا لردك ولكن الملف لايمكن فك الضغط عنه

واذا امكن تحديد ارقام الفواتير عن طريق الفلتر ثم ترحيلها

فى انتظار ردك

 

شكرا

[محمد ابو ضيف]

الاخوه 

 

هل من مساعده

[محمد ابو ضيف]

UP

[ناصر سعيد]

ملف الاجابه لايفتح وهذه هي الصوره

 

[محمد ابو ضيف]

حتى الان لا يوجد اجابه ؟

[ناصر سعيد]

في 11/18/2017 at 10:46, عاشق الاكسيل said:

دخل رقم الفاتورة فى الخلية D2 ودوس على Get Data

لعله المطلوب ( انا عدلت على ترتيب الاعمدة)

 

Alex Stock.rar

ياعاشق الاكسيل ضع كودك في مشاركه لاننا مش عارفين نفتح ملفك

[عبدللرحيم]

جرب فتح الملف

Alex Stock.zip

[ناصر سعيد]

Sub GetData()
    Dim LastRow As Long
    LastRow = Sheets("Received shipments").Cells(Rows.Count, 1).End(xlUp).Row
    
    'مسح المدى في صفحه الهدف
    Sheets("Shipments").Range("A5:D1000").ClearContents
    '=======
 'صف العناوين في شيت المصدر
 'حليتي عنوان العمود المطلوب فلترته
 ' يتم نسخهما ولصقهما في صفحه الهدف
 'كتابه المدى الذي سيم اللصق فيه في صفحه الهدف
    Sheets("Received shipments") _
    .Range("A4:D" & LastRow). _
    AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Shipments") _
    .Range("D1:D2"), _
    CopyToRange:=Sheets("Shipments") _
    .Range("A4:D4"), Unique:=True
    '=======

End Sub

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

[محمد ابو ضيف]

12 ساعات مضت, ناصر سعيد said:

Sub GetData()
    Dim LastRow As Long
    LastRow = Sheets("Received shipments").Cells(Rows.Count, 1).End(xlUp).Row
    
    'مسح المدى في صفحه الهدف
    Sheets("Shipments").Range("A5:D1000").ClearContents
    '=======
 'صف العناوين في شيت المصدر
 'حليتي عنوان العمود المطلوب فلترته
 ' يتم نسخهما ولصقهما في صفحه الهدف
 'كتابه المدى الذي سيم اللصق فيه في صفحه الهدف
    Sheets("Received shipments") _
    .Range("A4:D" & LastRow). _
    AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Shipments") _
    .Range("D1:D2"), _
    CopyToRange:=Sheets("Shipments") _
    .Range("A4:D4"), Unique:=True
    '=======

End Sub

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

ا/ ناصر

 

شكرا لردك ومساعدتك

هناك مشكله انه عند الترحيل من Received shipments يتم مسح البيانات من شيت shipments

مااريده هوا ان ترحل البيانات الجديده تحت القديمه وان تمسح من شيت received فقط

وهل توجد امكانيه ان احدد ارقام الفواتير عن طريق الفلتر وترحل مع بعضها بدلا من الترحيل واحده تلو الاخرى

 

فى انتظار ردك وشكرا لردك مره اخرى

[ناصر سعيد]

اخي الكريم

ادعو الله ان يرزقنا باحد الاخوه الكرام الذين وهبوا علمهم حبا لله

يجيب طلبك

[محمد ابو ضيف]

اى مساعده؟