mohebbi_md
2011/03/06, 14:11
سلام به همه ی دوستان عزیز
من یه ماکرو نوشتم که شماره ردیف رو از کاربر میگیره و اون ردیف رو در یه ردیف خالی در یه فایل دیگه کپی می کنه ولی این ماکرو مشکل داره و مشکلش اینه که فایل مورد نظر رو باز می کنه و کپی هم میکنه ولی وسط کار میپرسه که فرمولها رو هم کپی کنم یا نه !!!!! :s
میخوام اگه بشه بدون ابن که بپرسه خودش فرمول ها رو هم کپی کنه ! باید چیکار کنم ؟کدش رو در زیر گذاشتم :Sub copy()Dim intRowDestination As StringDim NameSheetDestination As StringDim intRowSource As IntegerDim Filename As StringDim destsheet As Worksheet'Destination addressFilename = "C:\Documents and Settings\mm\Desktop\prj\main.xls"Dim MyObject As Object'To get Number of Source RowintRowSource = InputBox("Enter Number of Row :", "Number of Row")'Select Source SheetSheets("task").Select'Find The Last Row in Destination Sheet ( Sheet2 )FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For i = 2 To FinalRow 'Decide if to copy based on column A ThisValue = Cells(i, 1).Value 'To check Number of Row If ThisValue = intRowSource Then Cells(i, 1).Resize(1, 33).copy Workbooks.Open Filename Set destsheet = Worksheets("task") destsheet.Activate NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste End If Next i ActiveWorkbook.Save ActiveWorkbook.CloseEnd Sub
من یه ماکرو نوشتم که شماره ردیف رو از کاربر میگیره و اون ردیف رو در یه ردیف خالی در یه فایل دیگه کپی می کنه ولی این ماکرو مشکل داره و مشکلش اینه که فایل مورد نظر رو باز می کنه و کپی هم میکنه ولی وسط کار میپرسه که فرمولها رو هم کپی کنم یا نه !!!!! :s
میخوام اگه بشه بدون ابن که بپرسه خودش فرمول ها رو هم کپی کنه ! باید چیکار کنم ؟کدش رو در زیر گذاشتم :Sub copy()Dim intRowDestination As StringDim NameSheetDestination As StringDim intRowSource As IntegerDim Filename As StringDim destsheet As Worksheet'Destination addressFilename = "C:\Documents and Settings\mm\Desktop\prj\main.xls"Dim MyObject As Object'To get Number of Source RowintRowSource = InputBox("Enter Number of Row :", "Number of Row")'Select Source SheetSheets("task").Select'Find The Last Row in Destination Sheet ( Sheet2 )FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For i = 2 To FinalRow 'Decide if to copy based on column A ThisValue = Cells(i, 1).Value 'To check Number of Row If ThisValue = intRowSource Then Cells(i, 1).Resize(1, 33).copy Workbooks.Open Filename Set destsheet = Worksheets("task") destsheet.Activate NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste End If Next i ActiveWorkbook.Save ActiveWorkbook.CloseEnd Sub