Copying rows from one sheet to another excluding "empty" rows

vbanoob22 · Feb 22nd 2018

Hello!

I'm VERY new to VBA, like, this is my first time trying to use it new. I have a sheet in excel (called Fedex) that is auto populated from a different sheet (invoice). I would like to copy entire rows from the fedex sheet that have a nonzero value in column A, such that in the new sheet I have a simple table of all items that have nonzero quantities. I have a module that is currently just copying the entire list into a new sheet, 0 rows included. Can someone please help me??

This is what I have currently (mostly just a copy from something online with some edits I tried to add to get it working):

Code

Sub cpynpst()
Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range
Set sh4 = Sheets("Fedex")
Set sh5 = Sheets("Sheet2")
For Each rng In sh4("A2:A")
If rng.Value <> 0 Then
lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("A2:A" & lr)
rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next rng
End Sub

Display More

Thank you!

**KjBox** · Feb 22nd 2018

Welcome to Ozgrid!

There is a conflict between your thread title and what you say in the thread. The title implies that entire rows might be empty, but your description says that column A might have a zero.

Might be best if you were to attach your workbook.

vbanoob22 · Feb 22nd 2018

Here is an attached workbook for reference. It is two sheets. The first sheet is the master list. the second sheet is what I would like the result to look like. I want to exclude rows with a 0 in a single cell.

**KjBox** · Feb 22nd 2018

Your sample file contains formulas that are liked to another workbook on your system. Obviously those links do not work for me when I open the file.

Can you make a sample file that replaces all the formulas with values (easiest way is to add a new sheet, select everything on the "COPY FROM" sheet and paste value only onto the new sheet).

Then clearly indicate which rows need to be copied to the "FINAL" sheet.

Do you really mean copy/paste not cut/paste? If copy/paste then the data will remain in the COPY FROM sheet and get duplicated in the FINAL sheet when the macro runs next time!

vbanoob22 · Feb 22nd 2018

Sorry for the poor explanations/examples. Again I am very new to this. I have adjusted the example worksheet and reattached it for reference. To clarify. The rows highlighted in green in the "COPY FROM" sheet are to be copied, NOT cut, and then transferred into the "Final" sheet such that the final sheet is a smaller table. The criterion for the rows to be copied is that there is a nonzero value in Column A. Every row with a natural number in A should get copied, every row with a 0 in A should be left behind.

As an add on, the number of rows in the "COPY FROM" sheet will eventually get longer, so expanding the range to greater than A21 would be useful for me.

Thank you for taking the time to help a novice out!

**KjBox** · Feb 23rd 2018

OK, sample file is fine now.

One last question, when the data is copied to the FINAL sheet should it be added to data that is already in that sheet or replace any data in the FINAL sheet?

vbanoob22 · Feb 23rd 2018

Hmmm good question I hadn't thought of that... Lets go with replace.

**KjBox** · Feb 23rd 2018

Try this.

Note that your sample FINAL sheet had a trailing space in the tab name ("FINAL " instead of "FINAL"), make sure you remove that trailing space.

Code

Sub CopyData()
    Dim x, y(), i As Long, ii As Long, iii As Long
    
    x = Sheets("COPY FROM").Cells(1).CurrentRegion
    For i = 1 To UBound(x, 1)
        If x(i, 1) <> 0 Then
            iii = iii + 1: ReDim Preserve y(1 To UBound(x, 2), 1 To iii)
            For ii = 1 To UBound(x, 2)
                y(ii, iii) = x(i, ii)
            Next
        End If
    Next
    With Sheets("FINAL")
        .Cells.Clear
        .[a1].Resize(iii, UBound(y, 1)) = Application.Transpose(y)
    End With


End Sub

Display More

vbanoob22 · Feb 23rd 2018

Sick! This works perfectly. Thank you so much!

**KjBox** · Feb 23rd 2018

You're welcome.

vbanoob22 · Mar 13th 2018

Hello again,

I hope its alright I post on this forum again. I have another question and you were so helpful last time. I am attempting to write another Macro that will copy certain columns form one worksheet into a specific column in another worksheet. The macro basically works, however it doesn't copy the values for 2 of the columns in the destination sheet. I will attach my workbook, as well as the code that I am running.

Here is my code:

Code

Sub NavisionInvoice()


Dim x, y(), i As Long, ii As Long, iii As Long    
  Dim sSrc As Worksheet    
  Dim sDest As Worksheet


Set wSrc = ActiveWorkbook    
  Set sSrc = ActiveSheet    
  Set sSrc = Worksheets("Homework")    
  Set sDest = Worksheets("NavInv")


With Sheets("NavInv")


sDest.Range("C2", sDest.Range("C2").End(xlDown)).Clear      
  sSrc.Range("A4", sSrc.Range("A4").End(xlDown)).Copy      
  sDest.Range("C2").PasteSpecial xlPasteValues


sDest.Range("D2", sDest.Range("D2").End(xlDown)).Clear      
  sSrc.Range("C4", sSrc.Range("C4").End(xlDown)).Copy      
  sDest.Range("D2").PasteSpecial xlPasteValues            
 
  sDest.Range("E2", sDest.Range("E2").End(xlDown)).Clear      
  sSrc.Range("D4", sSrc.Range("D4").End(xlDown)).Copy      
  sDest.Range("E2").PasteSpecial xlPasteValues            
 
  sDest.Range("F2", sDest.Range("F2").End(xlDown)).Clear      
  sSrc.Range("B4", sSrc.Range("B4").End(xlDown)).Copy      
  sDest.Range("F2").PasteSpecial xlPasteValues            
 
  sDest.Range("G2", sDest.Range("G2").End(xlDown)).Clear      
  sSrc.Range("E4", sSrc.Range("E4").End(xlDown)).Copy      
  sDest.Range("G2").PasteSpecial xlPasteValues


End With


End Sub

Display More

As you can see, I have just repeated the same step over and over. It worked for the copy into columns C, D, and F. However, columns E and G did not copy. I don't know why it would only have worked for a couple of the columns. Can you please help me again?

apo · Mar 14th 2018

Hi..

You should really create a new thread.. it helps when others are searching for the same solution..

Your code wasn't getting all the data you wanted because you were using xlDown instead of Xlup..

In any case.. try this:

Code

Sub Copy_Columns()
Dim x
 x = Sheets("HomeWork").Range("A4:H" & Sheets("HomeWork").Range("A" & Rows.Count).End(xlUp).Row)
 Sheets("NavInv").[C2].Resize(UBound(x, 1), 5).Value = Application.Index(x, Evaluate("row(1:" & UBound(x) & ")"), Array(1, 3, 4, 2, 5))
End Sub

btw.. Also post your code within the code tags.. it's the little hash symbol on the edit bar..

hjulian72 · Mar 4th 2021

Quote from KjBox

Try this.

Note that your sample FINAL sheet had a trailing space in the tab name ("FINAL " instead of "FINAL"), make sure you remove that trailing space.

Code

Sub CopyData()
    Dim x, y(), i As Long, ii As Long, iii As Long
    
    x = Sheets("COPY FROM").Cells(1).CurrentRegion
    For i = 1 To UBound(x, 1)
        If x(i, 1) <> 0 Then
            iii = iii + 1: ReDim Preserve y(1 To UBound(x, 2), 1 To iii)
            For ii = 1 To UBound(x, 2)
                y(ii, iii) = x(i, ii)
            Next
        End If
    Next
    With Sheets("FINAL")
        .Cells.Clear
        .[a1].Resize(iii, UBound(y, 1)) = Application.Transpose(y)
    End With


End Sub

Display More

Hi there

thanks so much for posting this. This is my first time using Visual Basic and your code works well. Except, I have one column that is account numbers and so those lines keep being copied to the new sheet. Is there a minor change I can make to deflect that column please? In my case it column D (4th column).

Many thanks for any help you can give.

**KjBox** · Mar 5th 2021

The simplest way is probably to copy across all the data then delete column 4. Try this

Code

Sub CopyData()
    Dim x, y(), i As Long, ii As Long, iii As Long
    
    x = Sheets("COPY FROM").Cells(1).CurrentRegion
    For i = 1 To UBound(x, 1)
        If x(i, 1) <> 0 Then
            iii = iii + 1: ReDim Preserve y(1 To UBound(x, 2), 1 To iii)
            For ii = 1 To UBound(x, 2)
                y(ii, iii) = x(i, ii)
            Next
        End If
    Next
    With Sheets("FINAL ")
        .Cells.Clear
        .[a1].Resize(iii, UBound(y, 1)) = Application.Transpose(y)
        .Columns(4).Delete
    End With

End Sub

Display More

hjulian72 · Mar 5th 2021

hi KjBox

many thanks for coming back so fast. Unfortunately that won't work for me in this instance. I have a table with multiple rows and columns, i want to copy across just the rows that contain certain complete columns (containing data), but i also need the account code that is in the D row. So the VBA needs to ignore the account code column for the calculation but carry the account code into the new sheet.

the way you have suggested would mean the rows would be selected but without the account code, and that would need to be entered manually afterwards.

is the a line i can add just ignoring a specific column?

many thanks for your help and ideas

**Carim** · Mar 5th 2021

Hello,

To make sure the suggested solution is exactly adapted to your specific situation .. why don't you attach a sample file ...

hjulian72 · Mar 5th 2021

thanks for the suggestion - the first tab is the amalgamated data from other sheets.

i want to just take the non zero rows (the ones with a unit price) into the export sheet (xero export)

at the moment the VBA sees the account codes and the amount columns as data, and copies them over (ie copies all the rows rather than just the ones with a unit price).

many thanks for your help

**royUK** · Mar 5th 2021

Do you need to add to the data already in the target sheet?

**KjBox** · Mar 5th 2021

Try this

Code

Sub CopyData()
    Dim x, y(), i As Long, ii As Long, iii As Long
    x = Sheets("xero lines").Cells(1).CurrentRegion
    
    For i = 1 To UBound(x, 1)
        If x(i, 4) <> 0 Then
            iii = iii + 1: ReDim Preserve y(1 To UBound(x, 2) - 1, 1 To iii)
            For ii = 1 To 3
                y(ii, iii) = x(i, ii)
            Next
            For ii = 5 To UBound(x, 2)
                y(ii - 1, iii) = x(i, ii)
            Next
        End If
    Next
    With Sheets("xero export")
        .Cells.Clear
        .[a1].Resize(iii, UBound(y, 1)) = Application.Transpose(y)
        .UsedRange.Borders.Weight = 2
        .UsedRange.Columns(5).NumberFormat = "0%"
    End With
    
End Sub

Display More

**royUK** · Mar 5th 2021

I would suggest automating AutoFilter

Code

Option Explicit

Sub CopyFiltered()
Dim lRw As Long
    With Sheet4
        If Not .AutoFilterMode Then .Range("A1").AutoFilter
        .Range("A1").AutoFilter Field:=4, Criteria1:=">0"
        With Sheet5
        lRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        End With
        .AutoFilter.Range.Resize(, 2).Copy Sheet5.Cells(lRw, 1)
        .Range("A3").AutoFilter
    End With

End Sub

Display More

Copying rows from one sheet to another excluding "empty" rows

Participate now!

Share