Forum Discussion
Solved
VBA code to count, copy, paste, last row, if
Good evening I have only trained myself in excel VBA and have been able to learn very much from other peoples questions. I need a code to copy the data in image 1 (Sheet1) to the table in image 2 (...
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
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?
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
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- Thank you. What can we do regarding the formula in CopytorecordsPL that refers to spray instruction PL?