VBA copy and paste to new sheet based on number of rows

[wolthers]

Hi, I am making a workbook to log all data based on coffee roast profiles sold.

Sales sheet has the following which I want to copy to log sheet.
B2 = sales ID
B4 = name (either company or person)

Then I can have data from D11 all the way to F20, and that's where I am finding difficulties, I can copy and paste D11:F11 but if I have more than one row then I will only have data on the first row on the log sheet.

D11	E11	F11
Light	Whole	1,250 g
Medium	Whole	2,500 g
Dark	Whole	2,500 g
Medium	Ground	750 g

log sheet is as follows:

(A)Day	(B)Order Nr	(C)Client	(D)Seller	(E)Roast	(F)Prep	(G)Quantity
16-06-20	SBC 00001	Baker	Dan	Light	Whole	1250
				Medium	Whole	2500
				Dark	Whole	2500
				Medium	Ground	750
16-06-20	SBC 00002	Lawyer	Tom	Light	Whole	1250
				Medium	Whole	2500
				Dark	Whole	2500
				Medium	Ground	750
16-06-20	SBC 00003	Dentist	Joe	Light	Whole	1250
				Medium	Whole	2500
				Dark	Whole	2500
				Medium	Ground	750

should look as follows:

(A)Day	(B)Order Nr	(C)Client	(D)Seller	(E)Roast	(F)Prep	(G)Quantity
16-06-20	SBC 00001	Baker	Dan	Light	Whole	1250
16-06-20	SBC 00001	Baker	Dan	Medium	Whole	2500
16-06-20	SBC 00001	Baker	Dan	Dark	Whole	2500
16-06-20	SBC 00001	Baker	Dan	Medium	Ground	750
16-06-20	SBC 00001	Lawyer	Tom	Light	Whole	1250
16-06-20	SBC 00001	Lawyer	Tom	Medium	Whole	2500
16-06-20	SBC 00001	Lawyer	Tom	Dark	Whole	2500
16-06-20	SBC 00001	Lawyer	Tom	Medium	Ground	750
16-06-20	SBC 00001	Dentist	Joe	Light	Whole	1250
16-06-20	SBC 00001	Dentist	Joe	Medium	Whole	2500
16-06-20	SBC 00001	Dentist	Joe	Dark	Whole	2500
16-06-20	SBC 00001	Dentist	Joe	Medium	Ground	750

my VBA macro:

Sub insert()

Dim ms As Worksheet, NR
Set ms = Sheets("log")
   With Sheets("sales")

       NR = ms.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
       

       ms.Range("A" & NR) = Date
       
           .Range("B2").Resize(1).Copy  'sale nr
       ms.Range("B" & NR).PasteSpecial xlValues
       
           .Range("B4").Resize(1).Copy  'client
       ms.Range("C" & NR).PasteSpecial xlValues
       
       myValue = InputBox("Quem vendeu") 'broker
       ms.Range("D" & NR).Value = myValue
       
'A B C and D should repeat the paste by the amount of rows between B11 and B20 with data

       .Range("d11:f11").Resize(10).Copy   'order
       ms.Range("E" & NR).PasteSpecial xlValues, Transpose:=False
    
    
   End With
  
End Sub

 

[Joe4]

I am confused. None of those seem to resemble the structure of the Log sheet example you posted in your initial post.
I thought we were starting with that, and when we are done, it should look like the last picture in the initial post.

 

[wolthers]

Sorry for the confusion, Joe.

The examples and file only have "fictional" data, I deleted all the data on the sheet 'log' so you could check it out fresh.
You can see what happens when you run the macro, what will be sent from sheet 'Venda' to sheet 'Log'

The whole idea is to press one button and it will fill up the log sheet with data from venda sheet, and also at the same time fill in the blanks.

 

[Joe4]

OK, I see what is going on. Your earlier code is making Excel think that the last row is row 11, not row 6. I think it may have something to do with transposing the data.
We will need to step through it to see what is going on. I need to step away for a while, but will be back on later tonight.

 

[Joe4]

Sorry for the delay in getting back to you. I never did make it back to the computer last night. Family affairs went longer than I expected.

I think I found the source of the problem. It is this line of your code:

.Range("d11:f11").Resize(10).Copy   'order

Basically, with "Resize(10)", you are telling it to copy 10 rows, even when there is less rows of data than that. So the macro sells G11 as the end row after the paste, even though the data really only goes down to G6.

So instead of telling it to copy 10 rows every time, let's find the ending row of data and only go down that far.
So, add another variable to your variable section like this:

Dim l2 as Long

and then replace the line of code I mentioned above with this instead:

lr2 = .Range("D10").End(xlDown).Row
.Range("D11:F" & lr2).Copy

and I think that should fix it for you.

 

[wolthers]

Don't worry about it Joe, thanks a lot again for all your help. Hope you and your family are doing good during these times.

It worked, the data is copied and filled in - thank you so much for taking the time on helping me sort this out!

 

[Joe4]

You may get that error if it is not finding any blanks in your range.
One way around it is something like this:

    Dim rng2 As Range
   
    On Error Resume Next
    Set rng2 = rng.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
   
    If Not rng2 Is Nothing Then
        rng2.FormulaR1C1 = "=R[-1]C"
    End If