با سلام و احترام
ببخشید دوستان مدتی تو انجمن درگیر این ماکرو هستم، نتونستم جواب اصولی براش پیدا کنم---------در ماکرو زیر جداولی از شیت 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]
|
اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید. |
|
علاقه مندی ها (Bookmarks)