Announcement

Collapse
No announcement yet.

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

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

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



    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
    Thank you!

  • #2
    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.
    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

    Comment


    • #3
      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.
      Attached Files

      Comment


      • #4
        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!
        We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

        Comment


        • #5
          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!
          Attached Files

          Comment


          • #6
            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?
            We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

            Comment


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

              Comment


              • #8
                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
                We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                Comment


                • #9
                  Sick! This works perfectly. Thank you so much!

                  Comment


                  • #10
                    You're welcome.
                    We now have a reputation system in place. If my reply helped please "Like" the reply by clicking the "Like" icon at bottom right of my reply.

                    Comment


                    • #11
                      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:

                      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

                      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?
                      Attached Files

                      Comment


                      • #12


                        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..
                        Valuable Resources:

                        snb's Website:
                        http://www.snb-vba.eu/index_en.html

                        Smallmans Website:
                        http://www.thesmallman.com/

                        Comment

                        Working...
                        X