Copy-paste rows as many times as nb of values on a cell

[notexpert]

Hello,

I have files with the following format:

Column A	Column B	Column C	Column D	Column E	Column F	Column G	Column H
Location name	Stand 1	Mn25	Maria	24/24	1/1	2,10	02-02-2021
Location name	Stand 1	Jn79	John	24/24	1/1	1,9	02-02-2021
Location name	Stand 1	Ge3	George	24/24	1/1	4,12	02-02-2021
Location name	Stand 1	So2	Sophie	24/24	1/1	3,11	02-02-2021

Every time I have to copy-paste the rows as many times as the values on column G (separated by comma) and only keep one value at the time on column G. The number of values on this column can vary from 1 up to 8 different values. So for the example above, the desired outcome would be the following:

Column A	Column B	Column C	Column D	Column E	Column F	Column G	Column H
Location name	Stand 1	Mn25	Maria	24/24	1/1	2​	02-02-2021
Location name	Stand 1	Mn25	Maria	24/24	1/1	10​	02-02-2021
Location name	Stand 1	Jn79	John	24/24	1/1	1​	02-02-2021
Location name	Stand 1	Jn79	John	24/24	1/1	9​	02-02-2021
Location name	Stand 1	Ge3	George	24/24	1/1	4​	02-02-2021
Location name	Stand 1	Ge3	George	24/24	1/1	12​	02-02-2021
Location name	Stand 1	So2	Sophie	24/24	1/1	3​	02-02-2021
Location name	Stand 1	So2	Sophie	24/24	1/1	11​	02-02-2021

How could I automate this? It takes forever to do it manually and I have files with hundreds of rows!

Thanks a lot in advance, it would be a world-changer for me if someone could help me! I don't have the knowledge to create macros and trying to just copy-paste macros that kinda do this, didn't work so far.

 

[Akuini]

Hi, @notexpert. Welcome to the Forum
Try this:
I put result in col J

Sub a1161175a()
Dim i As Long, j As Long, k As Long, n As Long
Dim va, vb, vc, x, z

n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A1:H" & n)
vb = Range("G1:G" & n)
ReDim vc(1 To UBound(va, 1) * 8, 1 To UBound(va, 2))

For i = 1 To UBound(va, 1)
    z = Split(vb(i, 1), ",")
    
    For Each x In z
        k = k + 1
    
        For j = 1 To UBound(va, 2)
            If j = 7 Then
                vc(k, j) = x
                Else
                vc(k, j) = va(i, j)
            End If
        Next
    
    Next

Next

'put result in col J
Range("J1").Resize(k, UBound(vc, 2)) = vc
End Sub

 

[notexpert]

Hi, @notexpert. Welcome to the Forum
Try this:
I put result in col J

Sub a1161175a()
Dim i As Long, j As Long, k As Long, n As Long
Dim va, vb, vc, x, z

n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("A1:H" & n)
vb = Range("G1:G" & n)
ReDim vc(1 To UBound(va, 1) * 8, 1 To UBound(va, 2))

For i = 1 To UBound(va, 1)
    z = Split(vb(i, 1), ",")
   
    For Each x In z
        k = k + 1
   
        For j = 1 To UBound(va, 2)
            If j = 7 Then
                vc(k, j) = x
                Else
                vc(k, j) = va(i, j)
            End If
        Next
   
    Next

Next

'put result in col J
Range("J1").Resize(k, UBound(vc, 2)) = vc
End Sub

Hi @Akuini Thanks a lot for your reply!
I tried it and it works! Many thanks! You made my day!

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.