Paste Values Into Next Blank Row

[davisshannon]

Hi,

I have a workbook with multiple sheets where I'm trying to copy rows where the value in column C > 0. I then want to paste these rows into a another sheet, called BoM. I'm ignoring the BoM sheet, along with a sheet called summary, and another sheet called Packet Storage.

I'm got my code partially working, but I'm having trouble getting the rows from each subsequent sheet to begin pasting on the next available row. I can loop through each sheet, but then the next sheet just starts pasting at the top again overwriting the last sheet's data. I'm also getting the row headers from each sheet pasted into the destination sheet, which would be ok the first time, but I don't want that from each sheet thereafter.

I'm sure there's a bit of ugliness in my code here (I'm a networking guy), so be nice. Thanks for your help on this in advance.

Here's my code:

Sub CopyRow()

For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "BoM" And ws.Name <> "Summary" And ws.Name <> "Packet Storage" Then
ws.Activate
Dim LastRow As Long
Dim x As Long
Dim rng As Range
x = 1

For Each rng In ActiveSheet.Range("C:C")
If rng > 0 Then
rng.EntireRow.Copy
With Sheets("BoM").Cells(x, 1)
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
x = x + 1
End If
Next rng
End If
Next


Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

 

[Leith Ross]

Hello davisshannon,

Try this amended version of your macro...

Sub CopyRow()


    Dim LastRow As Long
    Dim r       As Long
    Dim rng     As Range
    Dim x       As Long


        x = 1
        Application.ScreenUpdating = False
        
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "BoM" And ws.Name <> "Summary" And ws.Name <> "Packet Storage" Then
                ' // Data starts in row 2.
                Set rng = ws.Range("A2")


                ' // Expand the range width to the last header in row 1.
                Set rng = rng.Resize(1, ws.Cells(1, Columns.Count).End(xlToLeft))


                ' // Find the last row in column "C" with data.
                LastRow = ws.Cells(Rows.Count, "C").Row


                ' // Test if the worksheet has data.
                If LastRow >= rng.Row Then


                    ' // Expand the range to the ladt row with data.
                    Set rng = rng.Resize(RowSize:=LastRow - rng.Row + 1)
                    For r = 1 To rng.Rows.Count
                        If rng.Cells(r, "C") > 0 Then
                            rng.Rows(r).Copy Worksheets("BoM").Cells(x, 1)
                            x = x + 1
                        End If
                    Next r
                End If
            End If
        Next ws


        Application.CutCopyMode = False
        Application.ScreenUpdating = True


End Sub

 

[My Aswer Is This]

Try this:

Sub CopyRow()
'Modified 6/20/18 8:25 PM EDT
Application.ScreenUpdating = False
Dim i As Long
Dim rng As Range
Dim LastRow As Long
Dim Lastrowa As Long
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "BoM" And Sheets(i).Name <> "Summary" And Sheets(i).Name <> "Packet Storage" Then
        LastRow = Sheets(i).Cells(Rows.Count, "C").End(xlUp).Row
        For Each rng In Sheets(i).Range("C2:C" & LastRow)
            If rng > 0 Then
                Lastrowa = Sheets("BoM").Cells(Rows.Count, "A").End(xlUp).Row + 1
                rng.EntireRow.Copy
                
                With Sheets("BoM").Cells(Lastrowa, 1)
                    .PasteSpecial xlValues
                    .PasteSpecial xlFormats
                End With
            End If
        Next rng
    End If
Sheets(i).Rows(1).Copy Sheets("BoM").Rows(1)
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[davisshannon]

Thanks. I'm getting a 1004 error "Method resize of object range failed" for the following line:

Set rng = rng.Resize(1, ws.Cells(1, Columns.Count).End(xlToLeft))

Hello davisshannon,

Try this amended version of your macro...

Sub CopyRow()


    Dim LastRow As Long
    Dim r       As Long
    Dim rng     As Range
    Dim x       As Long


        x = 1
        Application.ScreenUpdating = False
        
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "BoM" And ws.Name <> "Summary" And ws.Name <> "Packet Storage" Then
                ' // Data starts in row 2.
                Set rng = ws.Range("A2")


                ' // Expand the range width to the last header in row 1.
                Set rng = rng.Resize(1, ws.Cells(1, Columns.Count).End(xlToLeft))


                ' // Find the last row in column "C" with data.
                LastRow = ws.Cells(Rows.Count, "C").Row


                ' // Test if the worksheet has data.
                If LastRow >= rng.Row Then


                    ' // Expand the range to the ladt row with data.
                    Set rng = rng.Resize(RowSize:=LastRow - rng.Row + 1)
                    For r = 1 To rng.Rows.Count
                        If rng.Cells(r, "C") > 0 Then
                            rng.Rows(r).Copy Worksheets("BoM").Cells(x, 1)
                            x = x + 1
                        End If
                    Next r
                End If
            End If
        Next ws


        Application.CutCopyMode = False
        Application.ScreenUpdating = True


End Sub

 

[My Aswer Is This]

Did you try my code in post 3 ??

 

[davisshannon]

Yeah, sorry, I did. It is actually only grabbing an image from one of the sheets not in column C, and then also grabbing a couple of items from the sheet that it should be ignoring, Packet Storage. It doesn't appear to be cycling through column C at all.

Did you try my code in post 3 ??

 

[My Aswer Is This]

Well I test all my script.

The script copies all rows if column C in that row if not empty.

Or what do you mean when you say Range is >0

Does this mean if Range is empty or the values like 1 is greater then zero

And my script does not look at sheet named Packet Storage
You may want to check your sheet names.

 

[davisshannon]

Thanks. Yeah, I'm trying to go through column C in a sheets except those 3 that I called out (Packet Storage shouldn't be evaluated). If the value is greater than 0 I then want to copy those rows into the sheet called BoM.

Well I test all my script.

The script copies all rows if column C in that row if not empty.

Or what do you mean when you say Range is >0

Does this mean if Range is empty or the values like 1 is greater then zero

And my script does not look at sheet named Packet Storage
You may want to check your sheet names.

 

[My Aswer Is This]

Try this:

Sub CopyRow()
'Modified 6/20/18 11:33 PM EDT
Application.ScreenUpdating = False
Dim i As Long
Dim rng As Range
Dim LastRow As Long
Dim Lastrowa As Long
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "BoM" And Sheets(i).Name <> "Summary" And Sheets(i).Name <> "Packet Storage" Then
        LastRow = Sheets(i).Cells(Rows.Count, "C").End(xlUp).Row
        For Each rng In Sheets(i).Range("C2:C" & LastRow)
            If rng.Value > 0 Then
                Lastrowa = Sheets("BoM").Cells(Rows.Count, "A").End(xlUp).Row + 1
                rng.EntireRow.Copy
                
                With Sheets("BoM").Cells(Lastrowa, 1)
                    .PasteSpecial xlValues
                    .PasteSpecial xlFormats
                End With
            End If
        Next rng
    End If
Sheets(i).Rows(1).Copy Sheets("BoM").Rows(1)
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[davisshannon]

Nope, identical results to last time. It's grabbing stuff from row A in Packet Capture, and then grabbing an image from column B in another sheet.