سليم حاصبيا قام بنشر أغسطس 1, 2018 مشاركة قام بنشر أغسطس 1, 2018 اذا كنت تريد ان يظهر لك ما يحتوي التحديد الذي قمت به (بدون الخلايا الفارغة) استعمل هذا الملف الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Selection.Cells(1, 1).Column = 1 Then Exit Sub If Selection.Cells.Count > 50 Then MsgBox "Too Many Data" Exit Sub End If Dim lasteRow Dim x% lasteRow = Cells(Rows.Count, 1).End(3).Row If lasteRow = 1 Then lasteRow = 2 If Application.CountA(Target) = 0 Then With Range("A1") .Value = Selection.Address With .Offset(1) .Resize(lasteRow, 1).Clear .Value = "Selection is Empty " .Interior.ColorIndex = 8 End With With .Offset(2) .Value = "ActiveCell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 End With End With Exit Sub End If Dim arr() Dim k%: k = 1 Dim cel As Range For Each cel In Selection If cel <> vbNullString Then ReDim Preserve arr(1 To k) arr(k) = cel.Value k = k + 1 Else: x = x + 1 End If Next With Me.Range("a1") .Value = Selection.Address .Offset(1).Resize(lasteRow, 1).Clear .Offset(1).Resize(k - 1, 1).Value = Application.Transpose(arr) With .Offset(k) .Value = "Active Cell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 With .Offset(1) .Value = "Items: " & Selection.Cells.Count - x .Interior.ColorIndex = 7 .Font.ColorIndex = 2 End With End With End With Me.Range("A:A").Columns.AutoFit Range("B1") = "Selection Address" Erase arr End Sub GET adderss of selection.xlsm 7 1 رابط هذا التعليق شارك More sharing options...
احمد بدره قام بنشر أغسطس 1, 2018 مشاركة قام بنشر أغسطس 1, 2018 كود رائع ودائمًا مبدع زادك الله علمًا 1 رابط هذا التعليق شارك More sharing options...
عامر ياسر قام بنشر أغسطس 1, 2018 مشاركة قام بنشر أغسطس 1, 2018 جزاك الله خيرا اسناذ سليم ابداع كل اعمالك 1 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أغسطس 1, 2018 مشاركة قام بنشر أغسطس 1, 2018 بارك الله فيك استاذنا سليم دائما مبدع جزاك الله كل خير 1 رابط هذا التعليق شارك More sharing options...
أحمد يوسف قام بنشر أغسطس 1, 2018 مشاركة قام بنشر أغسطس 1, 2018 أحسنت استاذ سليم بارك الله فيك ملف وكود رائعان 1 رابط هذا التعليق شارك More sharing options...
مجدى يونس قام بنشر أغسطس 1, 2018 مشاركة قام بنشر أغسطس 1, 2018 ماشاء الله نشاط ممتاز 1 رابط هذا التعليق شارك More sharing options...
abushuber قام بنشر أغسطس 3, 2018 مشاركة قام بنشر أغسطس 3, 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.