ترحيل القيم فقط . بدون ترحيل المعادلات أو الأكواد

[علي بن علي]

السلام عليكم وبها نبدأ

للخبراء 

تعديل هذا الكود في الملف المرفق

ولكن بشرط عند الترحيل 

لا ينسخ المعادلات الى الشيت الجديد المرحل اليه

بمعنى أوضح يرحل القيم فقط

ودمتم بخير وعافيه 

مرفق ملف به الكود كاملا

HOUS()
Dim sh As Worksheet
Dim nm
Dim x, lr
Dim arr
Dim ws As Worksheet: Set ws = Sheets(" 8")
Application.ScreenUpdating = False
x = InputBox("ÇÏÎá ÇÓã ÇáÔíÊ ÇáÐí ÓíÖÇÝ")

If x = "" Then MsgBox "ÇÏÎá ÇÓã ÇáÔíÊ ÇæáÇ", vbExclamation: Exit Sub
For Each sh In Sheets
If x = sh.Name Then
MsgBox "åÐÇ ÇáÇÏÎÇá ãæÌæÏ Öãä ÇÓãÇÁ ÇáÔíÊÇÊ", vbExclamation
Exit Sub
End If
Next sh
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = (x)
           Set nm = Sheets(x)
           nm.DisplayRightToLeft = True
           Sheets("Data").Range("B1:af1").Copy
           nm.Range("B1").PasteSpecial
           nm.Range("B1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
           SkipBlanks:=False, Transpose:=False
           Application.CutCopyMode = False
 lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
 ws.Range("B1:af" & lr).Copy nm.Range("B1")

الرجاء المساعده (1).xlsm

[حسونة حسين]

 وعليكم السلام ورحمة الله وبركاته 

استبدل

nm.Range("B1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone,SkipBlanks:=False, Transpose:=False
الى

nm.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,SkipBlanks:=False, Transpose:=False

 

وللاستفاده يمكنك الاطلاع على هذا الرابط