جلال الجمال_ابو أدهم قام بنشر نوفمبر 13, 2016 مشاركة قام بنشر نوفمبر 13, 2016 (معدل) تحياتى و ايام مباركه مرفق المطلوب مع تحديث البيانات عند ادخال تكويدات جديده مرفق المثال نقل كود و اسم الصنف من عدة اعمده لعمودين حسب المجموعه.rar تم تعديل نوفمبر 13, 2016 بواسطه جلال الجمال_ابو أدهم رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر نوفمبر 13, 2016 مشاركة قام بنشر نوفمبر 13, 2016 السلام عليكم ورحمة الله انسخ هذا الكود وخصص له زر Sub Trans_Cod() m = 3 Dim Arr As Variant, C As Range Arr = Array("D", "F", "H", "J", "L", "N") For i = LBound(Arr) To UBound(Arr) Set C = Sheet1.Columns(Arr(i)) LR = Sheet1.Cells(Rows.Count, C.Column).End(xlUp).Row For R = 5 To LR If Not IsEmpty(Sheet1.Cells(R, C.Column)) Then m = m + 1 Range("B" & m) = Sheet1.Cells(R, C.Column) Range("A" & m) = Sheet1.Cells(R, C.Column).Offset(0, 1) End If Next Next End Sub رابط هذا التعليق شارك More sharing options...
جلال الجمال_ابو أدهم قام بنشر نوفمبر 14, 2016 الكاتب مشاركة قام بنشر نوفمبر 14, 2016 زيزو العجوز تحياتى جزاك الله خيرا و لكنه يقوم بالترحيل فى sheet1ولكن يرجى الترحيل الى sheet2 بالعمودين A4_B4 شكرا رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر نوفمبر 14, 2016 مشاركة قام بنشر نوفمبر 14, 2016 السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub Trans_Cod() m = 3 Dim Arr As Variant, C As Range LS = Sheet2.Range("A" & Rows.Count).End(xlUp).Row Sheet2.Range("A4:B" & LS).ClearContents Arr = Array("D", "F", "H", "J", "L", "N") For i = LBound(Arr) To UBound(Arr) Set C = Sheet1.Columns(Arr(i)) LR = Sheet1.Cells(Rows.Count, C.Column).End(xlUp).Row For R = 5 To LR If Not IsEmpty(Sheet1.Cells(R, C.Column)) Then m = m + 1 With Sheet2 .Range("B" & m) = Sheet1.Cells(R, C.Column) .Range("A" & m) = Sheet1.Cells(R, C.Column).Offset(0, 1) End With End If Next Next End Sub 1 رابط هذا التعليق شارك More sharing options...
جلال الجمال_ابو أدهم قام بنشر نوفمبر 14, 2016 الكاتب مشاركة قام بنشر نوفمبر 14, 2016 زيزو العجوز تحياتى و جزاك الله خيرا هو المطلوب رابط هذا التعليق شارك More sharing options...
جلال الجمال_ابو أدهم قام بنشر نوفمبر 28, 2018 الكاتب مشاركة قام بنشر نوفمبر 28, 2018 (معدل) تحياتى و ايام مباركه كان الكود يعمل و الان فيه مشكله ماهو التعديل على الكود ليعمل كما هو مطلوب بالمرفق و شكرا لحضرتك أ/ابراهيم الحداد نقل كود و اسم الصنف من عدة اعمده لعمود واحد حسب المجموعه.rar تم تعديل نوفمبر 28, 2018 بواسطه جلال الجمال_ابو أدهم رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر نوفمبر 28, 2018 مشاركة قام بنشر نوفمبر 28, 2018 أحسنت استاذ ابراهيم كود ممتاز جعله الله فى ميزان حسناتك 1 رابط هذا التعليق شارك More sharing options...
جلال الجمال_ابو أدهم قام بنشر نوفمبر 28, 2018 الكاتب مشاركة قام بنشر نوفمبر 28, 2018 تحياتى و ايام مباركه تم تعديل الكود من زميل فاضل و هو الان يعمل Dim LR, LS, I, R, M As Integer Dim Arr As Variant, C As Range M = 3 LS = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1 Sheet2.Range("A4:B" & LS).ClearContents Arr = Array("D", "F", "H", "J", "L", "N") For I = LBound(Arr) To UBound(Arr) Set C = Sheet1.Columns(Arr(I)) LR = Sheet1.Cells(Rows.Count, C.Column).End(xlUp).Row For R = 5 To LR If Not IsEmpty(Sheet1.Cells(R, C.Column)) Then M = M + 1 With Sheet2 .Range("B" & M) = Sheet1.Cells(R, C.Column) .Range("A" & M) = Sheet1.Cells(R, C.Column).Offset(0, 1) End With End If Next Next رابط هذا التعليق شارك 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.