VBA code to count, copy, paste, last row, if

Kettie 

Like this:

Sub CopyToRecordPL()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim r1 As Long, r2 As Long
    Dim m1 As Long, m2 As Long, m3 As Long
    Dim n3 As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set wsh1 = ActiveSheet
    Set wsh2 = Worksheets("Records")
    m1 = wsh1.Range("A26").End(xlUp).Row
    m2 = wsh1.Range("B26").End(xlUp).Row
    m3 = wsh1.Range("F26").End(xlUp).Row
    n3 = m3 - 15
    n = wsh2.Range("b" & wsh2.Rows.Count).End(xlUp).Row + 1
    For r1 = 16 To m1
        For r2 = 16 To m2
                wsh2.Range("A" & n).Resize(n3).Value = wsh1.Range("U" & r2).Value
                wsh2.Range("B" & n).Resize(n3).Value = wsh1.Range("B" & r2).Value
                wsh2.Range("AA" & n).Resize(n3).Value = wsh1.Range("AB" & r1).Resize(n3).Value
                wsh2.Range("D" & n).Resize(n3).Value = wsh1.Range("F" & r1).Resize(n3).Value
                wsh2.Range("E" & n).Resize(n3).Value = wsh1.Range("G" & r1).Resize(n3).Value
                wsh2.Range("F" & n).Resize(n3).Value = wsh1.Range("H" & r1).Resize(n3).Value
                With wsh2.Range("G" & n).Resize(n3)
                    .Formula = "='" & wsh1.Name & "'!L16*" & _
                        "IF(OR('" & wsh1.Name & "'!N16={""KG"",""L""}),1000,1)/10"
                    .Value = .Value
                End With
                wsh2.Range("I" & n).Resize(n3).Value = wsh1.Range("O" & r1).Resize(n3).Value
                wsh2.Range("L" & n).Resize(n3).Value = wsh1.Range("R" & r1).Resize(n3).Value
                wsh2.Range("M" & n).Resize(n3).Value = wsh1.Range("M11").Value
                With wsh2.Range("N" & n).Resize(n3)
                    .Formula = "=TEXTJOIN("","",TRUE,'" & wsh1.Name & "'!$K$8," & _
                        "'" & wsh1.Name & "'!$K$7,'" & wsh1.Name & "'!$K$6)"
                    .Value = .Value
                End With
                wsh2.Range("O" & n).Resize(n3).Value = wsh1.Range("T" & r2).Value
                With wsh2.Range("Q" & n).Resize(n3)
                    .Formula = "=TEXTJOIN("","",TRUE,'" & wsh1.Name & "'!$G$8," & _
                        "'" & wsh1.Name & "'!$G$7,'" & wsh1.Name & "'!$G$6)"
                    .Value = .Value
                End With
                wsh2.Range("V" & n).Resize(n3).Value = "PL" & wsh1.Range("F5").Value
                wsh2.Range("Y" & n).Resize(n3).Value = wsh1.Range("P8").Value
                n = n + n3
        Next r2
    Next r1
    Application.ScreenUpdating = True
End Sub

Kettie 

If you make sure that the sheet you want to use instead of Spray Instructions PL is the active sheet when you run CopyToRecordPL, you can change the line

Set wsh1 = Worksheets("Spray instruction PL")

in CopyToRecordPL to

Set wsh1 = ActiveSheet

Thank you very much HansVogelaar. It seems that this code does the Job (I made small changes, but are happy with how they worked out). Sorry for the confusion. I worked on the layout of the original and did not apply them to the template. I added them now.

I found another problem that I need help with please. I added a macro called NextsprayinstructionPL(). This needs to be run before copytorecordsPL. The problem that is creates, is that it changes the name and then copytorecordsPL does not apply to it anymore. Is it dangerous to use "active sheet" in "copytorecordsPL" or do you have another plan for me please?

Kettie 

Is this better? (I'm a bit confused by the changes that you applied)

Sub CopyToRecordPL()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim r1 As Long, r2 As Long
    Dim m1 As Long, m2 As Long, m3 As Long
    Dim n3 As Long
    Dim n As Long
    Application.ScreenUpdating = False
    Set wsh1 = Worksheets("Spray instruction PL")
    Set wsh2 = Worksheets("Records")
    m1 = wsh1.Range("A26").End(xlUp).Row
    m2 = wsh1.Range("B26").End(xlUp).Row
    m3 = wsh1.Range("F26").End(xlUp).Row
    n3 = m3 - 15
    n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1
    For r1 = 16 To m1
        For r2 = 16 To m2
                wsh2.Range("A" & n).Resize(n3).Value = wsh1.Range("U" & r2).Value
                wsh2.Range("B" & n).Resize(n3).Value = wsh1.Range("B" & r2).Value
                ' Shouldn't KULTIVAR be copied?
                wsh2.Range("D" & n).Resize(n3).Value = wsh1.Range("F" & r1).Resize(n3).Value
                wsh2.Range("E" & n).Resize(n3).Value = wsh1.Range("G" & r1).Resize(n3).Value
                wsh2.Range("F" & n).Resize(n3).Value = wsh1.Range("H" & r1).Resize(n3).Value
                With wsh2.Range("G" & n).Resize(n3)
                    .Formula = "='Spray instruction PL'!L16*" & _
                        "IF(OR('Spray instruction PL'!N16={""KG"",""L""}),1000,1)/10"
                    .Value = .Value
                End With
                wsh2.Range("I" & n).Resize(n3).Value = wsh1.Range("O" & r1).Resize(n3).Value
                wsh2.Range("L" & n).Resize(n3).Value = wsh1.Range("R" & r1).Resize(n3).Value
                wsh2.Range("M" & n).Resize(n3).Value = wsh1.Range("M11").Value
                With wsh2.Range("N" & n).Resize(n3)
                    .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$K$8," & _
                        "'Spray instruction PL'!$K$7,'Spray instruction PL'!$K$6)"
                    .Value = .Value
                End With
                wsh2.Range("O" & n).Resize(n3).Value = wsh1.Range("T" & r2).Value
                With wsh2.Range("Q" & n).Resize(n3)
                    .Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$G$8," & _
                        "'Spray instruction PL'!$G$7,'Spray instruction PL'!$G$6)"
                    .Value = .Value
                End With
                wsh2.Range("V" & n).Resize(n3).Value = "PL" & wsh1.Range("F5").Value
                wsh2.Range("Y" & n).Resize(n3).Value = wsh1.Range("P8").Value
                ' I don't understand the following - column AB is empty
                ' wsh2.Range("AA" & n).Resize(n3).Value = wsh1.Range("AB" & r1).Resize(n3).Value
                n = n + n3
        Next r2
    Next r1
    Application.ScreenUpdating = True
End Sub