Forum Discussion
VBA code to count, copy, paste, last row, if
Try this macro:
Sub CopyData() 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, n As Long Application.ScreenUpdating = False Set wsh1 = Worksheets("Sheet1") Set wsh2 = Worksheets("Sheet2") m1 = wsh1.Range("A" & wsh1.Rows.Count).End(xlUp).Row m2 = wsh1.Range("B" & wsh1.Rows.Count).End(xlUp).Row m3 = wsh1.Range("C" & wsh1.Rows.Count).End(xlUp).Row n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1 For r1 = 2 To m1 For r2 = 2 To m2 wsh2.Range("A" & n).Resize(m3 - 1).Value = wsh1.Range("A" & r1).Value wsh2.Range("B" & n).Resize(m3 - 1).Value = wsh1.Range("B" & r2).Value wsh2.Range("C" & n).Resize(m3 - 1, 3).Value = wsh1.Range("C2:E" & m3).Value n = n + m3 - 1 Next r2 Next r1 Application.ScreenUpdating = True End Sub
Good afternoon HansVogelaar
Thank you for the swift response. It is almost there.
There is one thing that you can change for me please. I attached the doc. after I ran the code. There is three lines added for every one that is needed(From the 27 rows the code added, row number 11,15,19;20,24,28;29,33,37 are the exact data I need.). I think instead of trying to explain, I'm going to ask you to have a look at the columns that I highlighted in orange. The red text are data that I posted manually. It is only 9 lines. The code gives 27 lines. Also note that the order of the entries in the green column is not corresponding to the correct info in WSH 2 Column D to F
There was one "/10" that I already added to the IF formula.
Thank you so much for all the help.
Kind regards
My apologies, I misunderstood what you wanted. Try this version:
Sub CopyToRecords()
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet
Dim r1 As Long, r2 As Long
Dim m1 As Long, m2 As Long
Dim n2 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("F26").End(xlUp).Row
n2 = m2 - 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(n2).Value = wsh1.Range("U" & r2).Value
wsh2.Range("B" & n).Resize(n2).Value = wsh1.Range("B" & r2).Value
wsh2.Range("C" & n).Resize(n2).Value = wsh1.Range("C" & r2).Value
wsh2.Range("D" & n).Resize(n2).Value = wsh1.Range("F" & r1).Resize(n2).Value
wsh2.Range("E" & n).Resize(n2).Value = wsh1.Range("G" & r1).Resize(n2).Value
wsh2.Range("F" & n).Resize(n2).Value = wsh1.Range("H" & r1).Resize(n2).Value
With wsh2.Range("G" & n).Resize(n2)
.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(n2).Value = wsh1.Range("O" & r1).Resize(n2).Value
wsh2.Range("L" & n).Resize(n2).Value = wsh1.Range("R" & r1).Resize(n2).Value
wsh2.Range("M" & n).Resize(n2).Value = wsh1.Range("M11").Value
With wsh2.Range("N" & n).Resize(n2)
.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(n2).Value = wsh1.Range("T" & r2).Value
With wsh2.Range("Q" & n).Resize(n2)
.Formula = "=TEXTJOIN("","",TRUE,'Spray instruction PL'!$G$8," & _
"'Spray instruction PL'!$G$7,'Spray instruction PL'!$G$6)"
.Value = .Value
End With
wsh2.Range("U" & n).Resize(n2).Value = wsh1.Range("E" & r2).Value
wsh2.Range("V" & n).Resize(n2).Value = wsh1.Range("F5").Value
wsh2.Range("W" & n).Resize(n2).Value = wsh1.Range("D" & r2).Value
wsh2.Range("X" & n).Resize(n2).Value = wsh1.Range("O8").Value
wsh2.Range("Y" & n).Resize(n2).Value = wsh1.Range("P8").Value
n = n + n2
Next r2
Next r1
Application.ScreenUpdating = True
End SubLike 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- Thank you. What can we do regarding the formula in CopytorecordsPL that refers to spray instruction PL?
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?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 SubThanks again HansVogelaar. I am very close now. Everything goes to the correct place, but I got stuck again. The process gets repeated with the amout of what seems to be the count of column b * count of column f * count of column f (6*4*4=96 entries) only 24 is needed. The entries in red are needed, the rest in black are duplicates.
Please advise