nicola قام بنشر يناير 12, 2017 مشاركة قام بنشر يناير 12, 2017 اساتذة المنتدى والاعضاء الاكارم السلام عليكم ارجو المساعدة في كود ترحيل جيد وفعال يستطيع التعامل مع بيانات كثيرة سوف ترحل قرابة بيانات (56) عامود الي صفحة قاعدة البيانات في المرفقات مثال يشرح المطلوب بشكل تفصيلي ولكم جزيل الشكر والتقدير ملف البيانات.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يناير 12, 2017 مشاركة قام بنشر يناير 12, 2017 وعليكم السلام جرب الكود التالي Sub Test() Dim wsControl As Worksheet Dim wsData As Worksheet Dim wsDB As Worksheet Dim i As Long Dim lrwsData As Long Dim lrwsDB As Long Dim newlr As Long Dim cel As Range Dim rg As Range Application.ScreenUpdating = False Set wsControl = Sheets("Control") Set wsData = Sheets("Data") Set wsDB = Sheets("DB") Set rg = wsDB.UsedRange.Columns(2).Find(CDate(wsControl.[G1].Value2), , xlValues, xlWhole) If Not rg Is Nothing Then MsgBox "Date Existed", vbExclamation: Set rg = Nothing: Exit Sub lrwsDB = wsDB.Cells(Rows.Count, 5).End(xlUp).Row + 1 lrwsData = wsData.Cells(Rows.Count, 4).End(xlUp).Row For i = lrwsData To 2 Step -1 If Len(wsData.Cells(i, 4)) > 0 Then lrwsData = i: Exit For Next i wsData.Range("D2:BG" & lrwsData).Copy wsDB.Range("E" & lrwsDB).PasteSpecial xlPasteValues wsDB.Range("B" & lrwsDB).Value = wsControl.Range("G1").Value wsDB.Range("C" & lrwsDB).Value = wsControl.Range("G2").Value wsDB.Range("D" & lrwsDB).Value = wsControl.Range("G3").Value newlr = wsDB.Cells(Rows.Count, 5).End(xlUp).Row For Each cel In wsDB.Range("A" & lrwsDB & ":A" & newlr) cel.Value = cel.Row - 2 Next cel Application.CutCopyMode = False Application.ScreenUpdating = True End Sub 2 رابط هذا التعليق شارك More sharing options...
nicola قام بنشر يناير 12, 2017 الكاتب مشاركة قام بنشر يناير 12, 2017 (معدل) جزاك الله كل خير هذا ما اريده بالفعل شكرا على جهدك ووقتك وزادك الله من علمه لدي طلب بعد اذنك اريد ان لا اقوم بترحيل البيانات اذا كان يوجد نفس التاريخ من قبل تم تعديل يناير 12, 2017 بواسطه nicola رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يناير 12, 2017 مشاركة قام بنشر يناير 12, 2017 وجزيت بمثله أخي الكريم تم تعديل الكود السابق ليناسب طلبك الجديد رابط هذا التعليق شارك More sharing options...
nicola قام بنشر يناير 13, 2017 الكاتب مشاركة قام بنشر يناير 13, 2017 استاذي الكريم ياسر خليل أبو البراء يعجز اللسان عن شكرك بارك الله فيك وجزاك الله كل خير رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يناير 13, 2017 مشاركة قام بنشر يناير 13, 2017 وجزيت خيراً بمثل ما دعوت لي أخي الكريم تقبل تحياتي رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.