پرسش hاصلاح کد کپی کردن رنج خاصی از داده ها

[jack007]

با سلام و احترام

ببخشید دوستان مدتی تو انجمن درگیر این ماکرو هستم، نتونستم جواب اصولی براش پیدا کنم---------در ماکرو زیر جداولی از شیت 1 که نام آنها مثلا risk است به شیت دیگر کپی می شوند (در این ماکرو شیت4) و زیر هم لیست می شوند......تا اینجا مشکلی نیست اما اگر یکی از سلول های جدول های risk من در شیت 1 فرمول نویسی شده باشد طبق ماکرو زیر کپی بدرستی صورت نمی گیرد و در شیت 4 بجای محتوی سلول فرمول نویسی شده عبارت RFF# درج می شود (رفرنس رو گم می کنه) بطور مختصر می خوام بجای activesheet.paste کدی باشه که معادل paste value در اکسل باشه یعنی محتوای سلول را کپی کند.........................بسیار سپاس گذار

QUOTE]Application.ScreenUpdating = False]
Dim aa As Range
Dim r As Long
Dim c As Long
Dim cnt As Integer
Dim lrow As Long
(''cnt = Application.WorksheetFunction.CountIf(Sheets("shee t1").Range("A:e"), "risk
Sheet4.Columns("a:e").Clear
Sheets("Sheet1").Activate
Range("a1").Select
For i = 1 To cnt
Set aa = Sheets("sheet1").Cells.Find(What:="risk", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
r = aa.Row
c = Range("a" & (r + cnt)).End(xlDown).Row


Range("a" & r & ":e" & c).Select
Selection.Copy
Sheet4.Select
Range("a1").Value = "risk "
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("a" & lrow + 2).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Next


MsgBox ": تعداد جداول انتقال داده شده" & Chr(10) & cnt


Application.ScreenUpdating = True
End Sub

[/QUOTE]

[jack007]

سلام دوستان
ممنون از توجهتون .....فکر کنم
کد رو پیدا کردم اگه اشتباه هست اساتید لطفا صحیح ترین شکل اون رو بفرمایند

CODE/]
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
:=False, Transpose:=False
[/CODE]