ازهر عبد العزيز قام بنشر أغسطس 8, 2020 مشاركة قام بنشر أغسطس 8, 2020 السلام عليكم ,,,,, احتاج ترحيل بيانات من الورقة 2 الى الورقة 3 tset20.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر أغسطس 8, 2020 أفضل إجابة مشاركة قام بنشر أغسطس 8, 2020 التنسيقات بهذا الشكل و الألوان الباهرة تثقل الملف دون حاجة لها الكود Option Explicit Sub Tansfer_data() Dim Tabl As Range Dim m%, Ro%, x%, k%, LA% Dim B_rg As Range Set Tabl = Source.Range("A5").CurrentRegion Ro = Tabl.Rows.Count If Ro = 1 Then Exit Sub Set B_rg = But.Range("A1").CurrentRegion If B_rg.Rows.Count > 1 Then B_rg.Offset(1).Resize(B_rg.Rows.Count - 1) _ .Interior.ColorIndex = xlNone End If Set Tabl = Tabl.Offset(1).Resize(Ro - 1) x = But.Cells(Rows.Count, 4).End(3).Row + 1 But.Range("D" & x).Resize(Ro - 1, Tabl.Columns.Count).Value = _ Tabl.Value m = Application.CountA(But.Range("D:D")) m = But.Cells(m, 1).Offset(-Ro + 1).Row + 1 For k = 1 To 3 But.Cells(m, k) = Source.Cells(k, 2) Next LA = But.Cells(Rows.Count, 1).End(3).Row If LA > 2 Then But.Range("A2:C" & LA).Resize(, 3) _ .SpecialCells(2).Interior.ColorIndex = 35 End If Tabl.ClearContents End Sub الملف مرفق Azhar.xlsm 2 رابط هذا التعليق شارك More sharing options...
ازهر عبد العزيز قام بنشر أغسطس 8, 2020 الكاتب مشاركة قام بنشر أغسطس 8, 2020 شكرا جزيلا استاذ سليم حاصبيا وهو المطلوب جزاك الله عني كل خير رابط هذا التعليق شارك 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.