علي فاهم

روعه اضافه صف اوصفوف بعد بيانات الطلاب للاستاذ ياسر خليل
Private Sub CommandButton1_Click() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Dim lc As Long Dim c As Long Set ws = Sheets("بيانات الطلبة") c = ws.Range("Q1").Value If TextBox1.Text = ws.Range("F1") Then Me.Hide: TextBox1.Text = "" MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب", 64 Application.ScreenUpdating = False Application.Calculation = xlManual If ws.Range("Q1") < 1 Then Exit Sub For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف ناجح", "الحاله", "كنترول شيت", "رصد الترم الثانى", "كنترول شيت (2)", "رصد الترم الأول", "كشف الدور الثاني")) lr = IIf(LastRowColumn(sh, "R") = 9, 9, LastRowColumn(sh, "R")) lc = LastRowColumn(sh, "C") sh.Range("A" & lr).Resize(1, lc).AutoFill Destination:=sh.Range("A" & lr).Resize(c + 1, lc) On Error Resume Next sh.Range("A" & lr + 1).Resize(c, lc).SpecialCells(xlCellTypeConstants).ClearContents Next sh Application.Goto ws.Range("A1") Application.Calculation = xlAutomatic Application.ScreenUpdating = True Unload Me Else MsgBox "عفواً كلمة المرور خاطئه و لن يتم تنفيذ المطلوب", vbExclamation TextBox1.Text = "" TextBox1.SetFocus End If End Sub Function LastRowColumn(ws As Worksheet, rc As String) As Long Dim lng As Long If Application.WorksheetFunction.CountA(ws.Cells) <> 0 Then With ws If UCase(rc) = "R" Then lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row ElseIf UCase(rc) = "C" Then lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column End If End With Else lng = 1 End If LastRowColumn = lng End Function Private Sub UserForm_Click() End Sub لو شويه شرح في الكود لان فيه جديد علينا