Forum Discussion

Kettie's avatar
Kettie
Copper Contributor
Sep 08, 2020

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 (...
developer
Excel
Macros and VBA
office 365
  • HansVogelaar's avatar
    HansVogelaar
    Sep 08, 2020

    Kettie 

    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
HansVogelaar's avatar
HansVogelaar
MVP

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

Kettie's avatar
Kettie
Copper Contributor
Sep 22, 2020
Thank you. What can we do regarding the formula in CopytorecordsPL that refers to spray instruction PL?
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Sep 22, 2020

    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

Resources