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 (Sheet2).

The code has to:
1. Count the amount of cells used in column c
2. Copy the counted (in step 1) amount of cells in column c,d and e
3. Paste in last row +1 in sheet2 in column c,d and e
4. The date and name in column a and b should be added to every row that is pasted
5. This has to be done for every used cell found in column b

English is not my first language. Excuse me if the explanation is difficult to understand.

Thanks

 

 

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
    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
    • Kettie's avatar
      Kettie
      Copper Contributor
      Sep 09, 2020

      HansVogelaar Thank you very much for the quick reply and the help. It works exactly as I hoped. 

       

      Would you please help me to modify it so that it:

      1. Counts only in a set range in sheet 1 i.e A8:A18

      2. Copy the data in wsh1 A2, B2, A4, B4 to wsh2 column G,H,I,J

      3. IF wsh1 column G is in g : value in wsh1 column F/1000 and paste in wsh2 column F.

      4. IF wsh1 column G is in kg : Copy value in wsh1 column F and paste in wsh2 column F.

       

      Thank you 

       

       

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Sep 09, 2020

        Kettie 

        Here is a new version.

        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("A19").End(xlUp).Row
    m2 = wsh1.Range("B19").End(xlUp).Row
    m3 = wsh1.Range("C19").End(xlUp).Row - 7
    n = wsh2.Range("A" & wsh2.Rows.Count).End(xlUp).Row + 1
    For r1 = 8 To m1
        For r2 = 8 To m2
            wsh2.Range("A" & n).Resize(m3).Value = wsh1.Range("A" & r1).Value
            wsh2.Range("B" & n).Resize(m3).Value = wsh1.Range("B" & r2).Value
            wsh2.Range("C" & n).Resize(m3, 3).Value = wsh1.Range("C8:E" & m3 + 7).Value
            With wsh2.Range("F" & n).Resize(m3)
                .Formula = "=Sheet1!F8/IF(Sheet1!G8=""g"",1000,1)"
                .Value = .Value
            End With
            wsh2.Range("G" & n).Resize(m3, 2).Value = wsh1.Range("A2:B2").Value
            wsh2.Range("I" & n).Resize(m3, 2).Value = wsh1.Range("A4:B4").Value
            n = n + m3
        Next r2
    Next r1
    Application.ScreenUpdating = True
End Sub

Resources