VBA - Copy Variable Number of Rows from a Workbook to Another - vba

Question

Our office has recently updated to excel 2013 and a code which worked in the 2010 version is not working. I've searched on several threads here on SO and have yet to find a solution that works for this particular case.
The code identifies and copies a range of cells from an open workbook and logs them into a second workbook, one range of cells at a time. The reason it's set up to copy only 1 row at a time is because the number of rows to be copied varies from time to time. Since the change to 2013, the Selection.PasteSpecial functions have been triggering the debug prompt.
In practice, the worksheet is being used as a routing form. Once it's filled out, we run the code and save all the relevant information in a separate workbook. Since it's a routing form, the number of people on it varies, and we need a row for each person in order to track their 'status'.
The code:
Sub Submit()
'Transfer code
Dim i As Long, r As Range, coltoSearch As String
coltoSearch = "I"
'Change i = # to transfer rows of data. Needs to be the first row which copies over.
'This is to identify how many rows are to be copied over. If statement ends the for loop once an "empty" cell is reached
For i = 50 To Range(coltoSearch & Rows.Count).End(xlUp).Row
Set r = Range(coltoSearch & i)
If Len(r.Value) = 0 Then
Exit For
End If
'Copies the next row on the loop
Range(Cells(i, 1), Cells(i, 18)).Copy
'open the workbook where row will be copied to
Workbooks.Open FileName:= _
"Workbook2"
'definition for the first empty row in Workbook 2, or the row under the last occupied cell in the Log
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'selects the first cell in the empty row
ActiveSheet.Cells(erow, 1).Select
' Pastes the copied row from Workbook 1 into Workbook 2. First line is highlighted when debugging
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
'moves to the next row
Next i
Any thoughts? I'm open to all options. Thanks for your time.

Answer 1

The Working alternative to select is
ActiveSheet.Cells(erow, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
but just for be sure that everything is going fine you have to set the range where i you want to paste everything
dim rngToFill as range
Set rngToFill = ActiveSheet.Cells(erow, 1)
maybe instead of using ActiveSheet you have to define that sheet after opening the wb with
dim wb as Workbook, ws as worksheet
set wb = Workbooks.Open FileName:="Workbook2"
set ws = wb.Sheets(nameofthesheet) 'or number of the sheet
then
set rngToFill = ws.Cells(erow, 1)
then you can paste in that range using .PasteSpecial method, but before doing that, try to be sure that there is no merged cell and that the worksheet we're you are going to paste values is not protected.
rngToFill.PasteSpecial xlPasteValuesAndNumberFormats
Your code:
dim wb as Workbook, ws as worksheet
set wb = Workbooks.Open(FileName:="Workbook2")
set ws = wb.Sheets(nameofthesheet) 'or number of the sheet
erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
if erow = 0 then erow = 1
set rngToFill = ws.Cells(erow, 1)
rngToFill.PasteSpecial xlPasteValuesAndNumberFormats
The B plan is to use a for loop iterating throug the cell you want to copy... but it's painfull slowly!
Dim wb As Workbook, newWs As Worksheet, oldWs As Worksheet
Dim z As Integer
Set oldWs = ActiveSheet
Set wb = Workbooks.Open("Workbook2")
Set newWs = wb.Sheets(1)
erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If erow = 0 Then erow = 1
For z = 1 To 18
newWs.Cells(erow, z) = oldWs.Cells(i, z).Value
Next z
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
'moves to the next row
Next i