VBA code does not perform any action

[RCPT]

Hello,
I have a module with a code I have used several times in other sheets, a simple copy/paste. But for some reason I can't understand it just does not do anything. It doesn't return any error but it doesn't perform the instructed actions either.
Help is appreciated.

The code is as follows:


Sub CopyPH()
Dim wsc As Worksheet 'worksheet copy
Dim wsd As Worksheet 'worksheet destination
Dim lrow As Long 'last row of worksheet copy
Dim crow As Long 'copy row
Dim drow As Long 'destination row
Set wsc = Sheets("1.2 Post Harvest Plan")
Set wsd = Sheets("Consolidated Data")
lrow = wsc.ListObjects("PostHarvest_Plan").Range.Columns(11).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
crow = 4
drow = 4
With wsc
For crow = 4 To lrow 'starts at 4 because of the header row
wsd.Cells(drow, 2).Value = .Cells(crow, 11).Value
wsd.Cells(drow, 3).Value = .Cells(crow, 20).Value
wsd.Cells(drow, 4).Value = .Cells(crow, 17).Value
wsd.Cells(drow, 5).Value = .Cells(crow, 26).Value
wsd.Cells(drow, 6).Value = .Cells(crow, 34).Value
wsd.Cells(drow, 7).Value = .Cells(crow, 35).Value
wsd.Cells(drow, 10).Value = .Cells(crow, 41).Value
drow = drow + 1 'increasing the row in worksheet destination
Next crow
End With
End Sub

[Aflatoon]

What is the value of lrow when you run the code? If it's less than 4 the code won't do anything.

[georgiboy]

Have a look at the attachment, you will see it is doing something (maybe not what you want). Maybe you could fill out the result as you wish to see it on the attached and then attach back it here again.

I think at this point it will be faster to see the result and design our own code to solve the problem.

[snb]

MS prevented this in the listobject design.
Avoid reading more than once from a worksheet.
Exploit Excel's built-in options like advancedfilter.

This will suffice:

Sub M_snb()
Sheet2.Cells(1, 2).Resize(, 7) = Application.Index(Sheet1.ListObjects(1).HeaderRowRange.Value, 1, Array(11, 20, 17, 26, 34, 35, 41))
Sheet1.ListObjects(1).Range.AdvancedFilter 2, , Sheet2.Cells(1, 2).CurrentRegion
End Sub

[RCPT]

MS prevented this in the listobject design.
Avoid reading more than once from a worksheet.
Exploit Excel's built-in options like advancedfilter.

This will suffice:

Sub M_snb()
Sheet2.Cells(1, 2).Resize(, 7) = Application.Index(Sheet1.ListObjects(1).HeaderRowRange.Value, 1, Array(11, 20, 17, 26, 34, 35, 41))
Sheet1.ListObjects(1).Range.AdvancedFilter 2, , Sheet2.Cells(1, 2).CurrentRegion
End Sub


Thank you