Copy data on sheet2 to sheet1 base on column data.

[Tocix]

Please help me out. I want a vba that can automate this process that copy sheet2 to sheet1. For example on sheet2. Column D4 fruit column separate by a blank line with a new fruit with dates, purchase orders and quantity. There's six types of fruit that I need to keep track. What I want to do is to copy fruit types on column D all rows that are "apple" and copy data on column A,B and C and paste it to sheet1 on A9,B9 and C9 for Apple and D9,E9 and F9 for banana and so on. I'm sorry I'm trying to explain as best as I can.

Thank you very much.



A9 will always be apple
D9 will always be banana
G9 will always be grapes

example below

a b c D E F G H I date PO qty date PO qty date PO qty 9 3/18/2019 25 5789 4/21/2019 18 3009 4/25/2019 12 28 10 3/23/2019 60 6090 4/24/2019 39 5881 4/28/2019 99 64 11 12 <tbody> </tbody> Sheet1
A B C D date PO Qty Fruit 4 3/18/2019 25 5789 Apple 5 3/23/2019 60 6090 Apple 6 3/28/2019 30 3098 Apple 7 8 4/21/2019 18 3009 Banana 10 4/24/2019 39 5881 Banana 11 4/24/2019 68 3068 Banana 12 13 4/25/2019 12 28 Grapes 14 4/28/2019 99 64 <tbody> </tbody> Sheet2

<tbody>
</tbody>

****** id="cke_pastebin" style="position: absolute; top: 312px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

4/28/2019

<tbody>
</tbody>

 

[DanteAmor]

Try this

Sub copy_data()
  Dim sh2 As Worksheet, r As Range, j As Long, c As Range
  Set sh2 = Sheets("Sheet2")
  j = 1
  For Each r In sh2.Range("A2:C" & sh2.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants).Areas
    Set c = Union(sh2.Range("A1:C1"), r)
    c.Copy Sheets("Sheet1").Cells(8, j)
    j = j + 3
  Next
End Sub

 

[Tocix]

I probably gave a bad example. Code gave me an error. Can you please take at a look at the file?

https://www.dropbox.com/s/9uyvmcypwd3o58h/Fruit Pruchase order.xlsx?dl=0

 

[DanteAmor]

What error message the code sends you and on which line the macro stops.

If your data is on sheet2 as your initial example, you will see the result on sheet1.

 

[Tocix]

Your code work on sample sheet, but it does not work on my real sheet. gives run-time error "1004" macros stop at c.Copy Sheets("Sheet1").Cells(8, j). I tried adjusting code with no success.

Thanks

 

[DanteAmor]

Your code work on sample sheet, but it does not work on my real sheet. gives run-time error "1004" macros stop at c.Copy Sheets("Sheet1").Cells(8, j). I tried adjusting code with no success.

Thanks

What else says the error?
Do you have the protected sheet, or merged cells or what is the real example?