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