Copy data range in one sheet to another as values until a specific value arise

Question

In below code I need to copy a range from "Output for qualifying" and insert as values in "Output".

It works, but I need the code to stop copy the range when column A start to contain the value zero (0).

Is there a smart way to do that? Hope you guys can help me.

Sub Copy_to_output()

Worksheets("Output for qualifying").Range("A2:A400").Copy

Worksheets("Output").Range("A9").PasteSpecial Paste:=xlPasteValues


Worksheets("Output for qualifying").Range("B2:H400").Copy

Worksheets("Output").Range("E9").PasteSpecial Paste:=xlPasteValues


Worksheets("Output for qualifying").Range("J2:K400").Copy

Worksheets("Output").Range("L9").PasteSpecial Paste:=xlPasteValues


Worksheets("Output for qualifying").Range("Q2:Y400").Copy

Worksheets("Output").Range("N9").PasteSpecial Paste:=xlPasteValues


Application.CutCopyMode = False


End Sub

Do you mean you want to [find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba)? — BigBen, Jun 22 '20 at 13:53

score 0 · Answer 1 · answered Jun 22 '20 at 14:04

The only thing I can think of in your situation is to use the Find method.

So, in your code, find the first 0 value, then use that as your row reference for the copy. This is by no means a clean way for the operation, but will do the task.

Sub Copy_to_output()

    Dim lZeroRow As Long

    lZeroRow = Worksheets("Output for qualifying").Range("A:A").Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole).Row

    Worksheets("Output for qualifying").Range("A2:A" & lZeroRow).Copy

    Worksheets("Output").Range("A9").PasteSpecial Paste:=xlPasteValues


    Worksheets("Output for qualifying").Range("B2:H" & lZeroRow).Copy

    Worksheets("Output").Range("E9").PasteSpecial Paste:=xlPasteValues


    Worksheets("Output for qualifying").Range("J2:K" & lZeroRow).Copy

    Worksheets("Output").Range("L9").PasteSpecial Paste:=xlPasteValues


    Worksheets("Output for qualifying").Range("Q2:Y" & lZeroRow).Copy
 
    Worksheets("Output").Range("N9").PasteSpecial Paste:=xlPasteValues


    Application.CutCopyMode = False


End Sub

FaneDuru · Answer 2 · 2020-06-22T14:16:31.967

-1

Try the next code, please:

Sub Copy_to_output()
 Dim shOFQ As Worksheet, shO As Worksheet, lastRow As Long
 Set shOFQ =  Worksheets("Output for qualifying")
 Set shO = Worksheets("Output")
 lastRow = shOFQ.Range("A:A").Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole).row
  
  shO.Range("A9").Resize(lastRow, 1).Value = shOFQ.Range("A2:A" & lastRow).Value
  shO.Range("E9").Resize(lastRow, shOFQ.Range("B2:H" & lastRow).Columns.Count).Value = shOFQ.Range("B2:H" & lastRow).Value
  shO.Range("L9").Resize(lastRow, shOFQ.Range("J2:K" & lastRow).Columns.Count).Value = shOFQ.Range("J2:K" & lastRow).Value
  shO.Range("N9").Resize(lastRow, shOFQ.Range("Q2:Y" & lastRow).Columns.Count).Value = shOFQ.Range("Q2:Y" & lastRow).Value
End Sub

No need to use Copy Paste...

edited Jun 22 '20 at 14:16

answered Jun 22 '20 at 14:05

FaneDuru

38,298
4
19
27

@JBL: Glad I could help! But somebody, not able to understand, voted it down... It is fast, consumes less resources and short. Anyhow, when somebody supply a solution, we here check the code left side check box in order to make it **accepted answer**. In this way, somebody else searching for a similar issue, will know that the code worked. I could use the columns number instead of `shOFQ.Range("B2:H" & lastRow).Columns.Count`, but I proceeded in this way to allow you changing the range dimensions without needing to adapt anything else then the range address... – FaneDuru Jun 22 '20 at 16:31

Copy data range in one sheet to another as values until a specific value arise

2 Answers2