للرفع ممكن المشكله في الكود ده
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