VBA Copy and Paste failing to copy to second sheet

Togora

New Member
Hi All,

I have managed somehow to write some VBA code which does most of what I want but unfortunately only the last value from column 35 is being picked up and placed against the first item and I can't see why.

The spreadsheet has 38 columns and I want to:

1. Press a button and have it look up column 35 and find all cells greater than zero.
2. If the cell value in column 35 is greater than zero then copy across the respective rows in columns 1 to 4 and 35 to a second sheet and place them in columns 1 to 4 and column 10.
3. If the value in column 35 is equal to zero do not copy across any data from that row.

Thanks in advance.

Here is the code:

Code:
Private Sub CommandButton1_Click()


'Find last row
Dim LastRow As Long, erow As Long


'To check the last row of data on sheet


LastRow = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row


For i = 5 To LastRow '5=row five




If Sheet4.Cells(i, 35).Value <> 0 Then 'Value to be looked up - change to >0
    Sheet4.Cells(i, 1).Copy 'Copy column one
    erow = Sheet3.Cells(Rows.Count, 5).End(xlUp).Row 'Second worksheet
    Sheet4.Paste Destination:=Sheet1.Cells(erow + 1, 1) 'Copy and paste in column "A"
    
    
    Sheet4.Cells(i, 2).Copy 'Copy column two
    Sheet4.Paste Destination:=Sheet1.Cells(erow + 1, 2) 'Copy and paste in column "B"
    
    Sheet4.Cells(i, 3).Copy 'Copy column three
    Sheet4.Paste Destination:=Sheet1.Cells(erow + 1, 3) 'Copy and paste in column "C"
    
    Sheet4.Cells(i, 4).Copy 'Copy column four
    Sheet4.Paste Destination:=Sheet1.Cells(erow + 1, 4) 'Copy and paste in column "D"
    
    [B][COLOR=#ff0000]'This part isn't working correctly and is only picking up the very last value in the column[/COLOR][/B]
    Sheet4.Cells(i, 35).Copy 'Copy column Closing Stock
    Sheet4.Paste Destination:=Sheet1.Cells(erow + 1, 10) 'Copy and paste column Closing Stock
    
End If


Next i


Range("B2").Select 'Finish by selecting this cell


End Sub
 

Fluff

MrExcel MVP, Moderator
How about
Code:
Private Sub CommandButton1_Click()


'Find last row
Dim LastRow As Long, erow As Long



LastRow = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
erow = Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

With Sheet4
   .Range("A4:AI" & LastRow).AutoFilter 35, ">0"
   .AutoFilter.Range.Columns("A:D").Offset(1).Copy Sheet1.Range("A" & erow)
   .AutoFilter.Range.Columns("AI").Offset(1).Copy Sheet1.Range("J" & erow)
   .AutoFilterMode = False
End With
Range("B2").Select 'Finish by selecting this cell


End Sub
 

Togora

New Member
Eh, I'm astounded!

This fits the bill perfectly and all within 15 minutes of my initial post, many thanks.

Also, you massively improved the speed of my feeble offering so it now runs in seconds. It just shows how much I still have to learn.

One very quick question why would the formatting be removed from the cells directly under the final row of data?

A massive thanks.
 

Fluff

MrExcel MVP, Moderator
It's because an extra blank row is being copied.
If that's a problem let me know.
 

Togora

New Member
Hi Fluff,

If it is possible I would like to remove this issue but only if it is not overly complicated and would not use up too much of your time.

Thanks.
 

Fluff

MrExcel MVP, Moderator
How about
Code:
Private Sub CommandButton1_Click()


'Find last row
Dim LastRow As Long, erow As Long



LastRow = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
erow = Sheet1.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

With Sheet4
   .Range("A4:AI" & LastRow).AutoFilter 35, ">0"
   .AutoFilter.Range.Columns("A:D").Offset(1).Resize(LastRow - 4).Copy Sheet1.Range("A" & erow)
   .AutoFilter.Range.Columns("AI").Offset(1).Resize(LastRow - 4).Copy Sheet1.Range("J" & erow)
   .AutoFilterMode = False
End With
Range("B2").Select 'Finish by selecting this cell


End Sub
 

Togora

New Member
Your code is as before super fast and very concise. Many thanks your time and efforts, it is very much appreciated.

Have a great weekend and thanks again.
 

Togora

New Member
Hi,

I ran the above code at post #6 and it now fails at

Code:
[COLOR=#333333].AutoFilter.Range.Columns("A:D").Offset(1).Resize(LastRow - 4).Copy Sheet1.Range("A" & erow)[/COLOR]
with a

"Run-time error '91': Object variable or With block variable not set"

Going through the code a number of times I can't see what is wrong and the funny thing is I haven't changed the code since it was provided to me by Fluff.

Any pointers on what is wrong would be appreciated.

Thanks in advance
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Syntax errors
    Good Morning, Trying to compile a workbook, I keep getting a few errors. Here are the first two: [code=rich]Syntax Error: Function...
Top