将循环行复制到新的工作簿

我试图从一个工作簿复制从列AJ到AQ的数据，并将这些值粘贴到一个新的工作簿中。 行数是可变的（取决于用户）。 我已经尝试实现下面的代码，但它只将第一行粘贴到新的工作簿中：

Dim i, j, LastRow, LastRow2 Set OldBook = ActiveWorkbook Set NewBook = Workbooks.Add(xlWBATWorksheet) With NewBook .ActiveSheet.Name = "GMD" End With OldBook.Activate Sheets("Entry Sheet").Select LastRow = ActiveSheet.Range("AJ" & Rows.Count).End(xlUp).Row ''Finds the last row of the column with text LastRow2 = ActiveSheet.Range("AQ" & Rows.Count).End(xlUp).Row ''Finds the last row of the column with text For i = 1 To LastRow ''Sets the range of rows to be copied including header Range(Cells(i, 36), Cells(i, 43)).Select ''Selects relevant columns Selection.Copy NewBook.Activate Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues OldBook.Activate Sheets("Entry Sheet").Select Next i For j = 1 To LastRow ''Sets the range of Rows to be copied including header Range(Cells(j, 43), Cells(j, 44)).Select ''Selects relevant columns Selection.Copy NewBook.Activate Range("H1").Select ActiveSheet.Paste OldBook.Activate Sheets("Entry Sheet").Select Next j 

任何意见，我在做什么错了？

Answer 1

问题是，在你粘贴部分，你只是调用第一个单元格，它是在循环中，所以每次循环将粘贴在单元格A1。

另外如果你想要的只是值，最好是跳过剪贴板并直接赋值。 有了这个，你可以一起避免循环。

第三，避免使用select。

编辑：删除循环，并添加换行的换行文本。

 Dim i, LastRow Dim ws As Worksheet Set oldbook = ActiveWorkbook Set ws = oldbook.Sheets("Entry Sheet") Set newbook = Workbooks.Add(xlWBATWorksheet) With newbook .ActiveSheet.Name = "GMD" End With With ws LastRow = .Range("AJ" & .Rows.Count).End(xlUp).Row ''Finds the last row of the column with text newbook.Sheets("GMD").Range(newbook.Sheets("GMD").Cells(1, 1), newbook.Sheets("GMD").Cells(LastRow, 7)).Value = .Range(.Cells(1, 36), .Cells(LastRow, 43)).Value End With newbook.Sheets("GMD").Range("H:I").WrapText = True