I set up sheet 1 like this. The top left cell, Game, in this table is "A1" in your sheet. The code starts in Row 2
Game
|
Review |
User |
1 |
|
|
97 |
|
|
Grand Theft Auto V |
|
|
User: 8.2 |
|
|
18-Nov-14 |
|
|
2 |
|
|
95 |
|
|
The Last of Us Remastered |
|
|
User: 8.9 |
|
|
29-Jul-14 |
|
|
3 |
|
|
93 |
|
|
Metal Gear Solid V: The Phantom Pain |
|
|
User: 8.2 |
|
|
1-Sep-15 |
|
|
4 |
|
|
92 |
|
|
Journey |
|
|
User: 8.2 |
|
|
21-Jul-15 |
|
|
Then I put this code in Sheet1's code page
Option Explicit
Sub ReArrangeReviewList()
Dim LR As Long 'Last Row number
Dim rw As Long 'Generic Row number
Dim ReviewList As Range
Dim TF As Boolean 'TrueFalse
Dim WsF As Object
Set WsF = Application.WorksheetFunction
With Sheets("Sheet1")
'Remove "User:" from User Cells
LR = Cells(Rows.Count, "A").End(xlUp).Row
Set ReviewList = Range("A2:A" & LR)
TF = ReviewList.Replace("User: ", "")
Set ReviewList = Nothing
'Delete Date Rows
For rw = LR To 2 Step -5
.Rows(rw).Delete
Next rw
'Delete List# Rows
LR = Cells(Rows.Count, "A").End(xlUp).Row - 3
For rw = LR To 2 Step -4
.Rows(rw).Delete
Next rw
'Move Review and User Values
LR = Cells(Rows.Count, "A").End(xlUp).Row
For rw = 2 To LR Step 3
Cells(rw, "A").Cut (Cells(rw, "B"))
Cells(rw + 1, "A").Cut (Cells(rw, "A"))
Cells(rw + 2, "A").Cut (Cells(rw, "C"))
Next rw
'Delete Empty Rows
LR = Cells(Rows.Count, "A").End(xlUp).Row
For rw = LR To 2 Step -1
If WsF.CountA(.Rows(rw)) = 0 Then .Rows(rw).Delete
Next rw
End With
End Sub