للرفع ممكن المشكله في الكود ده 
  
Private Sub CommandButton1_Click() 
Dim sh As Worksheet 
Dim Lr As Long 
Dim Nm As String  
Set sh = ThisWorkbook.Sheets("ÇáÕÝÍÉ ÇáÑÆíÓíÉ") 
Lr = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 
sh.Range("A" & Lr) = Me.TextBox1 
    Sheets.Add After:=Sheets(Sheets.Count) 
    Application.CutCopyMode = False 
    ActiveSheet.DisplayRightToLeft = True 
    Feuil1.Columns("A:H").Copy 
    ActiveSheet.Paste 
    [b1] = Me.TextBox1 
    [E2].Select 
    Selection.Copy 
    Sheet2.Activate 
    QQ = sh.Cells(1000, 2).End(xlUp).Row + 1 
    sh.Rang("B:B").PasteSpecial xlPasteValues 
     
'Lr = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row + 1 
'    ActiveSheet.Paste Link:=True 
    Sheet1.Shapes("Rounded Rectangle 1").Copy 
    [G1].Select 
    ActiveSheet.Paste 
    ActiveSheet.Name = Me.TextBox1 
    Nm = ActiveSheet.Name 
    sh.Activate 
    sh.Range("A" & Lr).Select 
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Nm & "!A1", TextToDisplay:=Nm 
Me.TextBox1 = "" 
     
     
' Selection.Copy 
'    Sheets("Sheet2").Select 
'    Range("C39").Select  
     
End Sub