marwa41 قام بنشر أبريل 28, 2020 مشاركة قام بنشر أبريل 28, 2020 ارجو تعديل كود الترحيل او تصحيحه و رمضان كريم جديد محمد مسموع.xlsm رابط هذا التعليق شارك More sharing options...
عبدالفتاح في بي اكسيل قام بنشر أبريل 28, 2020 مشاركة قام بنشر أبريل 28, 2020 ما مشكلة الكود يجب توضيح اكثر حتى يتفاعل الاساتذه مع مشكلتك اختي الكريمة رابط هذا التعليق شارك More sharing options...
marwa41 قام بنشر أبريل 28, 2020 الكاتب مشاركة قام بنشر أبريل 28, 2020 عملت كود ترحيل من فاتورة الى المبيعات لكن عند الترحيل يرحل صف واحد فقط ولا يرحل الباقى البيانات رابط هذا التعليق شارك More sharing options...
الرائد77 قام بنشر أبريل 29, 2020 مشاركة قام بنشر أبريل 29, 2020 تفضل أخي ضع هذا مكان الكود الذي تستعمله. تغيير بسيط على الكود الذي في الملف Sub REDA() Application.ScreenUpdating = False Dim iRow As Long Dim rng As Range Dim cl As Range Set rng = ActiveSheet.Range("c14:c23") For Each cl In rng If cl <> "" Then iRow = Sheets("SLS").Range("C1048576").End(xlUp).Row + 1 With ThisWorkbook.Sheets("SLS") .Range("B" & iRow).Value = iRow - 1 .Range("C" & iRow).Value = Sheets("INV").Range("D7").Value .Range("D" & iRow).Value = Sheets("INV").Range("D8").Value .Range("E" & iRow).Value = cl.Value .Range("F" & iRow).Value = cl.Offset(, 1).Value .Range("G" & iRow).Value = cl.Offset(, 2).Value .Range("H" & iRow).Value = cl.Offset(, 3).Value .Range("I" & iRow).Value = cl.Offset(, 4).Value .Range("J" & iRow).Value = Sheets("INV").Range("G24").Value .Range("K" & iRow).Value = Sheets("INV").Range("G25").Value .Range("L" & iRow).Value = Sheets("INV").Range("G26").Value .Range("M" & iRow).Value = Sheets("INV").Range("G27").Value End With End If Next Sheets("INV").Range("D8").Value = "" Sheets("INV").Range("C14").Value = "" Sheets("INV").Range("C15").Value = "" Sheets("INV").Range("C16").Value = "" Sheets("INV").Range("C17").Value = "" Sheets("INV").Range("C18").Value = "" Sheets("INV").Range("C19").Value = "" Sheets("INV").Range("C20").Value = "" Sheets("INV").Range("C21").Value = "" Sheets("INV").Range("C22").Value = "" Sheets("INV").Range("C23").Value = "" Sheets("INV").Range("E14").Value = "" Sheets("INV").Range("E15").Value = "" Sheets("INV").Range("E16").Value = "" Sheets("INV").Range("E17").Value = "" Sheets("INV").Range("E18").Value = "" Sheets("INV").Range("E19").Value = "" Sheets("INV").Range("E20").Value = "" Sheets("INV").Range("E21").Value = "" Sheets("INV").Range("E22").Value = "" Sheets("INV").Range("E23").Value = "" Sheets("INV").Range("F14").Value = "" Sheets("INV").Range("F15").Value = "" Sheets("INV").Range("F16").Value = "" Sheets("INV").Range("F17").Value = "" Sheets("INV").Range("F18").Value = "" Sheets("INV").Range("F19").Value = "" Sheets("INV").Range("F20").Value = "" Sheets("INV").Range("F21").Value = "" Sheets("INV").Range("F22").Value = "" Sheets("INV").Range("F23").Value = "" Sheets("INV").Range("G25").Value = "" Sheets("INV").Range("G26").Value = "" Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر أبريل 29, 2020 أفضل إجابة مشاركة قام بنشر أبريل 29, 2020 بعد اذن اخي الرائد لا ضرورة لكل هذه الحلفات التكرارية (بدل التنقل داخل النطاق المطلوب نقله خلية خلية ) انسخ النطاق كاملاُ الى الخلية الهدف لاحظ هذا الكود Option Explicit Sub My_code_1() Dim CRow%, jRow%, HowMany% Dim rng As Range Dim I As Worksheet, S As Worksheet Set I = Sheets("INV"): Set S = Sheets("SLS") Set rng = Sheets("INV").Range("c14:c23") HowMany = Application.CountA(I.Range("c14").Resize(10)) CRow = S.Range("C1048576").End(xlUp).Row + 1 jRow = S.Range("J1048576").End(xlUp).Row + 1 CRow = Application.Max(jRow, CRow) I.Cells(14, "C").Resize(HowMany, 5).Copy S.Cells(CRow, "c").PasteSpecial (12) I.Range("G24:G27").Copy With S.Cells(CRow + HowMany, "J") .PasteSpecial (12), Transpose:=True .Resize(, 4).Interior.ColorIndex = 6 End With S.Cells(CRow, "H") = I.Cells(8, "D") S.Cells(CRow, "I") = I.Cells(7, "D") I.Range("C14:C23").ClearContents I.Range("D8").ClearContents Application.CutCopyMode = False End Sub الملف مرفق Salim_Book.xlsm 3 رابط هذا التعليق شارك More sharing options...
marwa41 قام بنشر أبريل 29, 2020 الكاتب مشاركة قام بنشر أبريل 29, 2020 ما شاءا الله يجعله الله فى ميزان حسناتكم 1 رابط هذا التعليق شارك More sharing options...
أحمد يوسف قام بنشر أبريل 29, 2020 مشاركة قام بنشر أبريل 29, 2020 marwa41 أين الضغط على الإعجاب لهذه الإجابة الممتازة واعتقد ان هذا اقل ما يقدم لصاحب الفضل بعد ربنا فى حل مشكلتك ؟!!!💙 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان