VBA Copy and Paste failing to copy to second sheet

Togora

New Member
Joined
Dec 1, 2018
Messages
21
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
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
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
Joined
Dec 1, 2018
Messages
21
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
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
It's because an extra blank row is being copied.
If that's a problem let me know.
 

Togora

New Member
Joined
Dec 1, 2018
Messages
21
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
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
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
Joined
Dec 1, 2018
Messages
21
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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,132
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Togora

New Member
Joined
Dec 1, 2018
Messages
21
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
 

Forum statistics

Threads
1,077,687
Messages
5,335,661
Members
399,032
Latest member
thefinu

Some videos you may like

This Week's Hot Topics

Top