عرض رسالة بكل الأوراق المختارة في ليست بوكس

[نايف - م]

السلام عليكم  ..عند أختيار عدة أوراق في الليست بوكس و طلب عرض الأوراق المختارة يعطين أخر ورقة فقط

نايف ترتسيب اوراق في مصنف.xlsm

[ابراهيم الحداد]

السلام عليكم و رحمة الله ..اجعل الكود هكذا

Private Sub CommandButton2_Click()
Dim ws As Worksheet, b As Boolean, s As String, x As Integer
    For Each ws In Worksheets

    For x = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(x) = True Then
        s = ListBox1.List(x)
        If s = ws.Name Then
         y = y & Chr(10) & ListBox1.List(x)
          End If
        End If
     Next x
    Next ws
    MsgBox y
End Sub

 

[نايف - م]

رائع سلمت الأيادي أستاذي الغالي  ..الأستاذ الكريم  ..كيف يمكنني نقل محتوى الورقيتين المختارات ل ليست بوكس

نايف ترتيب اوراق في مصنف.xlsm

[ابراهيم الحداد]

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

عذرا على التأخير بسبب ظروف خاصة ..ربما يفيدك هذا الكود

Private Sub CommandButton2_Click()
'الأوراق المختارة
Dim ws As Worksheet, b As Boolean, s As String, x As Integer
Dim Arr(), Ln As Long, sh As Worksheet
Dim p As Long, Cont As Long, C As Range, j As Integer
Dim Tmp(), r As Long, f As Integer
''''''''''''''''''''''
  ' Arr تخزين اسماء الشيتات المطلوب العمل عليها فى المصفوفة
    For Each ws In Worksheets
    For x = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(x) = True Then
        s = ListBox1.List(x)
        If s = ws.Name Then
        ReDim Preserve Arr(p)
        Arr(p) = s
        p = p + 1
           End If
          End If
     Next x
    Next ws
''''''''''''''''''''''
  ''Tmp' اعداد للمصفوفة الجديدة
On Error Resume Next
For i = 0 To UBound(Arr)
For Each sh In Sheets(Arr(i))
Ln = Sheets(Arr(i)).Range("A" & Rows.Count).End(3).Row
Cont = Cont + Ln
Next
Next
ReDim Preserve Tmp(Cont - 1)
r = 0
''''''''''''''''''''''''
 '  ' Tmp' تخزين البيانات فى المصفوفة
For j = 0 To UBound(Arr)
For Each C In Sheets(Arr(j)).Range("A1:A" & Ln)
If Len(C) > 0 Then
Tmp(r) = C.Value
r = r + 1
End If
Next
Next
''''''''''''''''''''''''
 '  استدعاء البيانات المخزنة للست بوكس
With Me.ListBox1
 .Clear
 .List = Tmp
End With
End Sub