Copy Looping Rows to New Workbook

Question

I'm trying to copy data from columns AJ through AQ from one workbook and paste the values in a new workbook. The number of rows is variable (dependent on the user). I've tried implementing the following code, but it only pastes the first row into the new workbook:

 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

Any observations on what I'm doing wrong?

Can you do workbooks.add with a variable? I would just leave it at add then set a sheet to first sheet in newbook like set ws=newbook.worksheets("Sheet1") and use that later. You can name the sheet "GMD" afterwards. Lunch time so excuse me but can post code upon return ^_^; — findwindow
I don't see why I couldn't, but I don't think that is what is causing the paste problem? However, I could be completely dense. I've also updated the code above to reflect a change. One of my cells contains linebreaks (which I need to transfer over to the new document). So I had to add a new loop to accommodate. I'm still stuck with only one line copying over however, and it doesn't copy over the header that is on row 1 either. Your insight would be greatly appreciated. — Lee Carver

Scott Craner Scott Craner · Accepted Answer · 2015-10-28T17:07:40

The problem is that in you paste section you are only calling the first cell and it is in the loop so each time the loop will paste in cell A1.

Also if all you want is values, it is best to skip the clipboard and assign the values directly. With this you can avoid the loop all together.

Thirdly avoid using the select.

Edit: Removed loop and added the wrap text for the line breaks.

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

Copy Looping Rows to New Workbook

1 Answers