كود لصق البيانات

[علي المصري]

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

اريد كود يقوم بعمل لصق البيانات المنسوخة على شكل قيم فقط

code for paste copy data as value only

[Ali Mohamed Ali]

حاول أستاذ علي تجرب هذا الكود

Public Sub CopyrangeA()
    Dim firstrowDB As Long, lastrow As Long
    Dim arr1, arr2, i As Integer
    firstrowDB = 1
    arr1 = Array("BJ", "BK")
    arr2 = Array("A", "B")
         For i = LBound(arr1) To UBound(arr1)
        With Sheets("SheetA")
           lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
           .Range(.Cells(1, arr1(i)), .Cells(lastrow, arr1(i))).Copy
           Sheets("SheetB").Range(arr2(i) & firstrowDB).PasteSpecial xlPasteValues
        End With
    Next
    Application.CutCopyMode = False
End Sub

 وممكن هذا الكود كمان

Sub CopyPaste()
Sheet1.Range("A:A").Copy 
Sheet2.Activate col = 1 Do Until Sheet2.Cells(1, col) = "" col = col + 1 Loop 
Sheet2.Cells(1, col).PasteSpecial xlPasteValues 
End Sub

أو ربما ذلك

Sub CopyPaste() 
Sheet1.Range("A:A").Copy 
Sheet2.Activate col = 1 
Do Until 
Sheet2.Cells(1, col) = "" col = col + 1 Loop
Sheet2.Cells(1, col).PasteSpecial xlPasteValues
End Sub

وأخر كودجميل

Sub PasteSpecial_ValuesOnly()
    Worksheets("Sheet1").Range("A1:Z100").Copy
'PasteSpecial Values Only
  Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
'Clear Clipboard (removes "marching ants" around your original data set)
  Application.CutCopyMode = False
  End Sub

 

[علي المصري]

شكرا على الاهتمام

ولكن المطلوب كما يلي

عند نسخ بيانات من ملف اخر وعمل لصق لهذه البيانات في ملف الاكسيل سواء

عن طريق استخدام  Ctrl+V أو أي طريقة أخرى يبدأ تنفيذ الكود ويجعل عملية اللصق ( لصق القيم فقط ) ( أي لا  يتم لصق التنسيق والمعادلات وغيرها )

مع الشكر الجزيل

[نبيل عبد الهادي]

 () Sub copy_paste
'كود منع اهتزاز الشاشة
Application.ScreenUpdating = False
'كود اختيار نسخ البيانات من ملف معين ويمكن تغير المدى بما يلائم عملك
    Range("A1:G18").Select
    Selection.Copy
    كود ارسال البيانات المنسوخه ولصقها في الملف الهدف "القيم فقط'"
    'ويمكن لك تغير اسم الملف والمسار بما يتلائم وعملك
    "Workbooks.Open Filename:="C:\Users\nabil\Desktop\file b.xlsm
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    'كود حفظ العمل
    ActiveWorkbook.Save
    'كود غلق الملف المستهدف
    ActiveWindow.Close
    Range("A1").Select
End Sub

 

[علي المصري]

ما اقصده موضح بالمرفق

جزاكم الله خيرا

111.rar

[ظفر الله عسكر]

6.zip