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

السلام عليكم ورحمة الله جرب هذا الكود Sub Add_Data() Dim ws As Worksheet, Arc As Worksheet Dim LR As Long Set ws = Sheets("hassila") Set Arc = Sheets("Archives") LR = Arc.Range("A" & Rows.Count).End(xlUp).Row ws.Range("A7:D" & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy Arc.Activate Arc.Range("A" & LR + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False ' :اذا اردت مسح البيانات من الورقة الاولى قم بازالة العلامة التى على اليسار من العبارة التالية 'ws.Range("A7:D" & ws.Range("A" & Rows.Count).End(xlUp).Row-1).ClearContents End Sub

السلام عليكم ورحمة الله ربما Lab يرمز الى Label و Lab.Caption يقصد بها ان العنوان الذى سوف يظهر على Label يكون هو النص او القيمة المكتوبة فى الصف ii و العمود 3

السلام عليكم ورحمة الله اجعل الكود هكذا Sub المجموع() Dim mr As Worksheet Dim LR, i, x, y, z, w, v As Long Dim WFS As Variant Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False Set WFS = WorksheetFunction Set mr = Sheets("mark") LR = mr.Range("c" & Rows.Count).End(xlUp).Row For i = 9 To LR For x = 11 To 157 Step 10 mr.Cells(i, x) = WFS.sum(mr.Cells(i, x - 2), mr.Cells(i, x - 1)) Next x For y = 14 To 157 Step 10 mr.Cells(i, y) = WFS.sum(mr.Cells(i, y - 2)

السلام عليكم ورحمة الله شكرا لكلماتك الرقيقة جعل الله لك من دعاءك الطيب نصيبا ووفقنا لما يحب و يرضى

السلام عليكم ورحمة الله جرب هذا الملف للامانة العلمية توجد ورقة مخفية بالملف للتمكن من تحقيق الهدف المبيعات.xlsm

السلام عليكم ورحمة الله اخى الكريم معاذ بارك الله فيك بصراحة العبقرية الحقيقية فى هذا الرد الجميل منك لقد اخجلتم تواضعنا

السلام عليكم ورحمة الله بورك فيك اخى الكريم محمد جعل الله لك من دعاءك لى نصيبا و زيادة ان شاء الله

السلام عليكم ورحمة الله اجعل الكود هكذا Private Sub CommandButton1_Click() UserForm1.TextBox1 = "" Dim ChekCapn As String, Data As String Dim ChekBx As Control, FData As String For Each ChekBx In Me.Controls If TypeName(ChekBx) = "CheckBox" Then ChekCapn = ChekBx.Caption If ChekBx.Value = True Then Data = Data & "," & ChekCapn FData = Mid(Data, 2, Len(Data) - 1) End If End If Next UserForm1.TextBox1.Value = FData Unload Me End Sub

السلام عليكم ورحمة الله نعم اخى الكريم يمكنك اضافة عشرات الشيك بوكس الاخرى

السلام عليكم ورحمة الله انظر الى هذا الملف ربما يكون هذا مطلبك ملف توضيح.xlsm

السلام عليكم ورحمة الله استخدم هذا الكود فى اليوزرفورم الثانى Private Sub CommandButton1_Click() UserForm1.TextBox1 = "" Dim ChekCapn As String, Data As String Dim ChekBx As Control For Each ChekBx In Me.Controls If TypeName(ChekBx) = "CheckBox" Then ChekCapn = ChekBx.Caption If ChekBx.Value = True Then Data = Data & "," & ChekCapn End If End If Next UserForm1.TextBox1.Value = Data Unload Me End Sub

السلام عليكم ورحمة الله البقاء لله انا لله و انا اليه راجعون

السلام عليكم ورحمة الله استخدم هذا الكود Sub AnalysesData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long, j As Long, p As Long Dim Arr, Data As String Set ws = Sheets("ورقة1") Set Sh = Sheets("ورقة2") Sh.Range("B5").Resize(100, 6).ClearContents LR = ws.Range("D" & Rows.Count).End(xlUp).Row Data = Sh.Range("B2") Arr = ws.Range("B3:G" & LR).Value ReDim Preserve Arr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 4) = Data Then p = p + 1 For j = 1 To UBound(Arr, 2) Arr(p, j) = Arr(i, j) Next End If Next If p > 0 Then Sh.Range("

السلام عليكم ورحمة الله جربى هذا الكود Sub ImportData() Dim ws As Worksheet, Sh As Worksheet Dim p As Integer, x As Integer, LR As Long Dim C As Range, A, B Application.ScreenUpdating = False Set Sh = Sheets("DataReport") A = Sh.Range("K2"): B = Sh.Range("L2"): p = 1 LR = Sh.Range("B" & Rows.Count).End(xlUp).Row For Each ws In ThisWorkbook.Worksheets x = ws.Tab.ColorIndex If x = 10 Then For Each C In ws.Range("A6:A" & ws.Range("A" & Rows.Count).End(xlUp).Row) If C >= B And C <= A Then p = p + 1 Sh.Range(Sh.Cells(p, 2), Sh.Cells(p, 9)).Value = ws.Range(ws.Cells(C.Row,

السلام عليكم ورحمة الله تفضل Sub ShetName() Dim ws As Worksheet, x As Variant Dim C As Range, WsName As String Dim OpenSht As String For Each ws In ThisWorkbook.Worksheets x = ws.Tab.ColorIndex Set C = ws.Range("A1") If IsNumeric(C.Value) And C.Value > 0 And x = 3 Then WsName = ws.Name & Chr(10) & "Cells Is Value = " & C.Value OpenSht = MsgBox(" Are You Want To Open : " & WsName, vbYesNo) If OpenSht = vbYes Then ws.Activate Exit For End If End If Next End Sub