samycalls2020 قام بنشر أبريل 12, 2018 مشاركة قام بنشر أبريل 12, 2018 (معدل) السلام عليكم هذا كود اخوتى الكرام يقوم بجلب بيانات من جدول فى ورقة DATA الى جدول أخر فى ورقة AS جدول DATA به صفوف فارغة فى أكثر من موضع لأن بياناته مجلوبه بمعادلات الكود يعمل جيداً .. والمراد تعديل فقط هو أن لاينقل الكود الصفوف الفارغة Sub SS() ' كود نسخ Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B7:U406").ClearContents lr = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy sh.Range("B" & lr).PasteSpecial xlPasteValues Application.CutCopyMode = False Application.ScreenUpdating = False End Sub تم تعديل أبريل 12, 2018 بواسطه samycalls2020 رابط هذا التعليق شارك More sharing options...
samycalls2020 قام بنشر أبريل 12, 2018 الكاتب مشاركة قام بنشر أبريل 12, 2018 للرفع رابط هذا التعليق شارك More sharing options...
samycalls2020 قام بنشر أبريل 12, 2018 الكاتب مشاركة قام بنشر أبريل 12, 2018 للرفع رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أبريل 12, 2018 مشاركة قام بنشر أبريل 12, 2018 (معدل) تفضل أخى الكريم تمت الإجابة من قبل الأستاذ ياسر خليل Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B7:U406").ClearContents lr = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy sh.Range("B" & lr).PasteSpecial xlPasteValues On Error Resume Next sh.Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = False End Sub تم تعديل أبريل 12, 2018 بواسطه ali mohamed ali رابط هذا التعليق شارك More sharing options...
samycalls2020 قام بنشر أبريل 12, 2018 الكاتب مشاركة قام بنشر أبريل 12, 2018 السلام عليكم أ/ على .. وصلنى الكود من أ / ياسر مشكوراً .. وبتجربيته لم يعمل وإليكم المرفق ترحيل بيانات.rar 1 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أبريل 12, 2018 مشاركة قام بنشر أبريل 12, 2018 (معدل) تفضل أخى الكريم ترحيل بيانات.rar تم تعديل أبريل 12, 2018 بواسطه ali mohamed ali 1 رابط هذا التعليق شارك More sharing options...
samycalls2020 قام بنشر أبريل 13, 2018 الكاتب مشاركة قام بنشر أبريل 13, 2018 (معدل) سلام الله عليك أ / على تحياتى وتقديرى .. أنا لدى الكود كما ارسلته لكم فى المرفق وهو كود يعمل جيداً وكل ما أريدة فقط هو تعديل بسيط بحيث لا يجلب الصفوف الفارغة وأليك المرفق مرة أخرى ترحيل بيانات2.rar تم تعديل أبريل 13, 2018 بواسطه samycalls2020 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أبريل 13, 2018 مشاركة قام بنشر أبريل 13, 2018 (معدل) هذا الكود الستاذ ياسر خليل يفى بالغرض Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B3:U1026").ClearContents lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 2 ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy sh.Range("B" & lr).PasteSpecial xlPasteValues On Error Resume Next sh.Columns(5).Replace 0, "" sh.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = False End Sub تم تعديل أبريل 13, 2018 بواسطه ali mohamed ali 1 رابط هذا التعليق شارك More sharing options...
samycalls2020 قام بنشر أبريل 13, 2018 الكاتب مشاركة قام بنشر أبريل 13, 2018 جزيل الشكر رابط هذا التعليق شارك 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.