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]

Just activate the sheet in your code like this:

Sub MyFillMacro()

    Dim lr As Long
    Dim rng As Range
  
'   Specify the worksheet you want this to happen on
    Sheets("Sheet6").Activate
  
'   Find last row with data in column G
    lr = Cells(Rows.Count, "G").End(xlUp).Row

'   Set range
    Set rng = Range("A1:G" & lr)

'   Fill in blanks with formulas
    rng.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
  
'   Turn formulas into values
    rng.Value = rng.Value

End Sub

If that doesn't work, then it must think those blank rows at the bottom of column G really have something in them.
Are there formulas or spaces in them?

 

[wolthers]

If that doesn't work, then it must think those blank rows at the bottom of column G really have something in them.
Are there formulas or spaces in them?

There are no formulas on the column G, is there a way for me to upload the spreadsheet?

 

[Joe4]

is there a way for me to upload the spreadsheet?

You can upload files to file sharing sites, like DropBox or a Google Drive account, if you have one, and then provide a link here to the files.
Note that I can only download files from my home computer, so I wouldn't be able to download it until later tonight when I am on that computer.

Try running this code, and tell me what it returns:

Sub Test()

    Dim lr As Long
    Dim ln As Long

    Sheets("Sheet6").Activate

    lr = Cells(Rows.Count, "G").End(xlUp).Row
    ln = Len(Range("G" & lr))
    
    MsgBox "There is an entry of length " & ln & " in cell G" & lr
    
End Sub

 

[wolthers]

This is what happens, see from line G7 to G11 it should be empty, then I ran macro again including your line, and it filled up the blank between G7:G11, and added the rest there too, but there should be nothing from row 17 and down. Now if I run macro again, the same will repeat, filling up 1500 from G18-G21, and adding the new data after A22.

 

[Joe4]

If you use the latest version of my code, it should be stopping at that row, row 16.
If it is not, check again to make sure that you have copied and pasted over my latest version. Note that there were updates in a few places.

 

[wolthers]

I was using the latest version of your code, even tested it on a new macro separately, recorded it on video, check it out.

 

[Joe4]

I was using the latest version of your code, even tested it on a new macro separately, recorded it on video, check it out.

I will have check that later when I am at my home computer. My workplace security setting blocks those sites.

 

[wolthers]

Thanks Joe, I really appreciate your help! Here's a link for the workbook in case you want to look, note I am keeping the codes together in one macro only.

 

[Joe4]

Thanks Joe, I really appreciate your help! Here's a link for the workbook in case you want to look, note I am keeping the codes together in one macro only.

This looks an "after" view of the the data after you ran the code that wasn't working correctly.
Do you have a "before" copy of the data, so I can try running the code exactly on that?

 

[wolthers]

Hi Joe, edited the file, I guess it should be updated there on the link now without your code and without data now.

Edit: the data being sent to the sheet called log is on the sheet called venda