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
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
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
 
Upvote 0
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.
 
Upvote 0
It's because an extra blank row is being copied.
If that's a problem let me know.
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top