Forum Discussion

Kettie's avatar
Kettie
Copper Contributor
Sep 08, 2020
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 (...
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

Resources