شرح هذا الكود

[اركان الاسلام]

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

لكى نتعلم منك نفعك الله بهذا العلم وجعله من العلم الذى تنتفع به يا اخى

Option Explicit

Sub Add_sheet()
 Dim myname As Worksheet
 Dim P As Worksheet
 Dim sh_n%, k%, i%
 Set P = Sheets("اليوميه")
 sh_n = Application.CountA(P.Range("B:B")) - 1
 Dim x%, t%: t = 2
 Dim mn$
Application.ScreenUpdating = False
  '''''''''''''''''''''''''''''''''''''''''
  For i = 2 To sh_n
               On Error Resume Next
               mn = Sheets(P.Range("b" & i) & "").Name
               x = Len(mn)
        If x = 0 Then
            P.Copy after:=Sheets(Sheets.Count)
             With ActiveSheet
             .Name = P.Range("b" & i)
             .Range("G14") = P.Range("F" & i)
             .Range("a1").CurrentRegion.Offset(1).ClearContents
             .Range("A:A").NumberFormat = ("dd- mm-yyy")
              For k = 2 To sh_n + 1
              If P.Range("b" & k) = ActiveSheet.Name Then
               ActiveSheet.Cells(t, 1).Resize(, 4).Value = _
               P.Range("A" & k).Resize(, 4).Value
               t = t + 1
              End If
              Next
            End With
            '=========================================
        Else
            
            Set myname = Sheets(P.Range("b" & i) & "")
            myname.Range("a1").CurrentRegion.Offset(1).ClearContents
            For k = 2 To sh_n + 1
              If P.Range("b" & k) = myname.Name Then
               myname.Cells(t, 1).Resize(, 4).Value = _
               P.Range("A" & k).Resize(, 4).Value
               t = t + 1
        End If
              Next
              
         ''''''''''''''''''''''''''''''''''''
  End If
    mn = ""
    Err.Number = 0
    t = 2
   Next i
   P.Select
 Application.ScreenUpdating = True

End Sub

 

tarhil_by_names.xlsm

[اركان الاسلام]

up