اختيار بالفتلر واظهار البيانات المختاره ؟

[محمود عدوى]

السلام عليكم ورحمة الله وبركاته

لو ممكن لو انا هعمل خليه بال data validation وعاوز اني اما اختار حاجه منها يملي البيانات لوحده هعمل البيانات ف كذا ورقه فرعية او ف ورقه فرعيه هملي فيها البيانات دي

انا عملتها بال في لوك اب بس ع صغير انما ع كبير كده ممكن حد يساعدنى

وشكرا ليكم وكل عام وانتم بخير

مرفق مثال بسيط

مثال 1.zip

[سليم حاصبيا]

جرب هذا الماكرو

Option Explicit

Sub Give_Data()
Dim k, x, t As Integer
Dim sh1, sh2 As Worksheet
Dim my_rg As Range
Set sh1 = Sheets("بيانات")
Set sh2 = Sheets("Sheet1")

k = sh1.Cells(2, Columns.Count).End(xlToLeft).Column
        For x = 2 To k Step 8
                  If my_rg Is Nothing Then
                        Set my_rg = sh1.Cells(2, x).Resize(4, 1)
                   Else
                         Set my_rg = Union(my_rg, sh1.Cells(2, x).Resize(4, 1))
                  End If
        Next
  t = sh2.Range("b2").Value
   If Not IsNumeric(t) Or t <= 0 Then MsgBox "Choose correct Number in $B$2...Please": Exit Sub
  If t > my_rg.Areas.Count Then t = my_rg.Areas.Count
         With my_rg.Areas(t)
                sh2.Cells(4, 2) = .Cells(1)
                sh2.Cells(4, 6) = .Cells(1).Offset(0, 4)
                sh2.Cells(5, 2) = .Cells(2)
                sh2.Cells(5, 6) = .Cells(2).Offset(0, 4)
                sh2.Cells(6, 2) = .Cells(3)
                sh2.Cells(7, 2) = .Cells(4)
        End With
End Sub

مرفق الملف

 

example1 salim.rar

[محمود عدوى]

6 ساعات مضت, سليم حاصبيا said:

جرب هذا الماكرو

Option Explicit

Sub Give_Data()
Dim k, x, t As Integer
Dim sh1, sh2 As Worksheet
Dim my_rg As Range
Set sh1 = Sheets("بيانات")
Set sh2 = Sheets("Sheet1")

k = sh1.Cells(2, Columns.Count).End(xlToLeft).Column
        For x = 2 To k Step 8
                  If my_rg Is Nothing Then
                        Set my_rg = sh1.Cells(2, x).Resize(4, 1)
                   Else
                         Set my_rg = Union(my_rg, sh1.Cells(2, x).Resize(4, 1))
                  End If
        Next
  t = sh2.Range("b2").Value
   If Not IsNumeric(t) Or t <= 0 Then MsgBox "Choose correct Number in $B$2...Please": Exit Sub
  If t > my_rg.Areas.Count Then t = my_rg.Areas.Count
         With my_rg.Areas(t)
                sh2.Cells(4, 2) = .Cells(1)
                sh2.Cells(4, 6) = .Cells(1).Offset(0, 4)
                sh2.Cells(5, 2) = .Cells(2)
                sh2.Cells(5, 6) = .Cells(2).Offset(0, 4)
                sh2.Cells(6, 2) = .Cells(3)
                sh2.Cells(7, 2) = .Cells(4)
        End With
End Sub

مرفق الملف

 

example1 salim.rar

تسلم ياغالي بس انا كنت بدور ع طريقه من غير ماكرو طريقه عاديه

والف شكر ليك هو فعلا شغال زي مانت عملته بس لو فيه طريقه تانيه اكون شاكر ليك

وتسلم لردك ومجهودك