Option Explicit
Sub insert_data()
Dim Da As Worksheet, Ch As Worksheet
Dim Rg_ch As Range
Dim frst, secd, cnt%, i%, Lr%, X%, tt%
Dim arr(8)
Set Da = Sheets("Data"): Set Ch = Sheets("Choise")

arr(0) = "A": arr(1) = "B": arr(2) = "G"
arr(3) = "K": arr(4) = "M": arr(5) = "F"
arr(6) = "N": arr(7) = "Q"

frst = Ch.Range("E2"): secd = Ch.Range("E3")
Set Rg_ch = Ch.Range("A5").CurrentRegion
If Rg_ch.Rows.Count > 1 Then _
  Rg_ch.Offset(1).Resize(Rg_ch.Rows.Count - 1).ClearContents

Lr = Da.Cells(Rows.Count, 1).End(3).Row
For i = 2 To Lr
  If Da.Range("F" & i) = frst And _
       Da.Range("G" & i) = secd Then
      
          With Ch.Cells(cnt + 6, 2)
          .Offset(, -1) = cnt + 1
              For tt = LBound(arr) To UBound(arr) - 1
               .Offset(, tt) = Da.Cells(i, arr(tt))
              Next tt
            cnt = cnt + 1
          End With
    
    End If
 Next
 
End Sub

1. بارك الله فيك سيدي الفاضل............لقد وفيت وكفيت
   
   فقط هناك ملاحظات
   1-.هو انني اريد ان تكون كل البيانات موجودة ومعبئة في الصفحة المطلوبة قبل تفعيل دور الاختيارات المنسدلة ثم ياتي بعدها دور و عمل كل اختيار حسب التدرج..فاذا اخترت المستوى مثلا فيتبغي ان تظهر البيانات لذاك المستوى وليس الصفحة فارغة بعدها اذا اخترت القسم يتم عرض بيانات ذلك القسم وهكذا ....ارجو ا ان تكون الفكرة وصلت وصلت
   
2. أي بمعنى آخر ... و كاننا نقوم بعملية الفرز و التصفية على الاختيارات التي نريدها ان تظهر فقط دون غيرها ....
   
   
3. اي اظهار البيانات وتخصيصها على ما يقع اختيارنا عليه من المنسدل...
   
   
   
   
   
5. حتى انني في الملف تركت فراغ في القائمة المنسدلة حتى اتمكن من تجاهل الاختيار ان اردت ذلك
   
   
6. ..ونفس الشيئ اريده في ااختيارات المنسدلة للعناوين..اي اذا وقع الاختيار يتم تفعيل ذلك واذا لم
   
   
   
   
   
9. يقع الاختيار وترك الفراغ فلا يتم عرض العنوان وبياناته...شكراااااااااا جزيييلااا
   
   
   
   
   
   
   
   

Option Explicit
Dim Da As Worksheet, Ch As Worksheet
Dim Rg_ch As Range, rg As Range
Dim frst, secd, cnt%, i%, Lr%, tt%, k%, x
'++++++++++++++++++++++++++++++++++++++++++++

Sub insert_data_By_data_val()
Dim arr(7)
Set Da = Sheets("Data"): Set Ch = Sheets("Choise")
'//////////////////////////////////////
Rem Initialize the Headres To array

For i = 2 To 9
 Set rg = Da.Range("A1:Q1").Find(Ch.Cells(5, i), lookat:=1)
  If Not rg Is Nothing Then
  x = Left(rg.Address(0, 0), 1)
  arr(i - 2) = x
  End If
 Next

'//////////////////////////////////////

frst = Ch.Range("E2"): secd = Ch.Range("E3")
Set Rg_ch = Ch.Range("A5").CurrentRegion
If Rg_ch.Rows.Count > 1 Then _
  Rg_ch.Offset(1).Resize(Rg_ch.Rows.Count - 1).Clear
  '++++++++++++++++++++++++++++++++++++++
  Lr = Da.Cells(Rows.Count, 1).End(3).Row
    Select Case True
      Case frst = vbNullString And secd <> vbNullString
          k = 6: GoTo frst_Yes_sec_No
      Case frst <> vbNullString And secd = vbNullString
          k = 5: GoTo frst_No_sec_yes
      Case frst = vbNullString And secd = vbNullString
          GoTo Both_no
      Case frst <> vbNullString And secd <> vbNullString
          GoTo Both_Yes
    End Select
    '+++++++++++++++++++++++++++++++++++++++
frst_Yes_sec_No:
cnt = 0
For i = 2 To Lr
    If Da.Cells(i, 1).Offset(, k) = secd Then
        With Ch.Cells(cnt + 6, 2)
            .Offset(, -1) = cnt + 1
                For tt = LBound(arr) To UBound(arr) - 1
                 .Offset(, tt) = Da.Cells(i, arr(tt))
                Next tt
            cnt = cnt + 1
        End With
    End If
Next i
GoTo Format_range
  
 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++
frst_No_sec_yes:
cnt = 0
For i = 2 To Lr
    If Da.Cells(i, 1).Offset(, k) = frst Then
    With Ch.Cells(cnt + 6, 2)
        .Offset(, -1) = cnt + 1
            For tt = LBound(arr) To UBound(arr)
              .Offset(, tt) = Da.Cells(i, arr(tt))
            Next tt
        cnt = cnt + 1
    End With
    End If
Next i
GoTo Format_range
  '++++++++++++++++++++++++++++++++++++++++++++++++++++
Both_no:
cnt = 0
For i = 2 To Lr
    With Ch.Cells(cnt + 6, 2)
    .Offset(, -1).Select
        .Offset(, -1) = cnt + 1
          For tt = LBound(arr) To UBound(arr)
            .Offset(, tt) = Da.Cells(i, arr(tt))
          Next tt
    End With
    cnt = cnt + 1
Next
GoTo Format_range
  '+++++++++++++++++++++++++++++++
Both_Yes:
cnt = 0
For i = 2 To Lr
    If Da.Range("F" & i) = frst And _
        Da.Range("G" & i) = secd Then
        With Ch.Cells(cnt + 6, 2)
            .Offset(, -1) = cnt + 1
                For tt = LBound(arr) To UBound(arr)
                 .Offset(, tt) = Da.Cells(i, arr(tt))
                Next tt
            cnt = cnt + 1
        End With
    End If
Next
Format_range:
  Set Rg_ch = Ch.Range("A5").CurrentRegion
  If Rg_ch.Rows.Count > 1 Then
   Set Rg_ch = Rg_ch.Offset(1).Resize(Rg_ch.Rows.Count - 1)
    With Rg_ch
     .Font.Size = 18: .Font.Bold = True
     .InsertIndent 1: .Interior.ColorIndex = 35
      .Borders.LineStyle = 1
      .Value = .Value
      Columns(2).NumberFormat = "0000"
    End With
   End If
End Sub

جزاكم الله خيراً ....وجعلها في صحائف أعمالكم إلى يوم الدين....حقيقة يعجز اللسان

. ما شاء الله