Change data layout

I currently have a three columns of data which I need to convert to a different layout using VBA.

I need to go from this:

Tag	Drawing	Drawing Type
1	I1	IFC
1	I2	IFC
1	R1	Redline
1	B1	Bootleg
2	I3	IFC
2	R2	Redline
2	B2	Bootleg
3	I4	IFC
4	R3	Redline
5	I5	IFC
5	B3	Bootleg
5	D1	Detail
6	I6	IFC
6	I7	IFC
6	R4	Redline
6	R5	Redline
6	B4	Bootleg

To this:

Tag	IFC	IFC	Redline	Redline	Bootleg	Detail
1	I1	I2	R1		B1
2	I3		R2		B2
3	I4
4			R3
5	I5				B3	D1
6	I6	I7	R4	R5	B4

The duplicates are removed from the "Tag" column, but if there are duplicates in the "Drawing Type" column for that tag, new columns need to be added to accommodate the different drawing numbers. Any help would be appreciated. Thanks

All of the credit for this goes to MickG at Mr. Excel

Sub MG24Nov23()
Dim Dn As Range
Dim Rng As Range
Dim Dic As Object
Dim Q As Variant
Dim n As Long
Dim Rw As Long
Dim Ac As Long
Dim k As Variant
Dim p As Variant
Dim c As Long
Dim R As Range
Dim col As Long

Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
For Each Dn In Rng
If Not Dic.Exists(Dn.Value) Then
Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
End If

If Not Dic(Dn.Value).Exists(Dn.Offset(, 2).Value) Then
Dic(Dn.Value).Add (Dn.Offset(, 2).Value), Array(1, Dn)
Else
Q = Dic(Dn.Value).Item(Dn.Offset(, 2).Value)
Q(0) = Q(0) + 1
Set Q(1) = Union(Q(1), Dn)
Dic(Dn.Value).Item(Dn.Offset(, 2).Value) = Q
End If
Next Dn

With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each k In Dic.keys
c = c + 1
For Each p In Dic(k)
If Not .Exists(p) Then
.Add p, Array(Dic(k).Item(p)(0), 0)
Else
Q = .Item(p)
Q(0) = Application.Max(Q(0), Dic(k).Item(p)(0))
.Item(p) = Q
End If
Next p
Next k
c = 1
For Each k In .keys
For n = 1 To .Item(k)(0)
c = c + 1
Q = .Item(k)
If Q(1) = 0 Then Q(1) = c
.Item(k) = Q
Next n
Next k
ReDim Ray(1 To Dic.Count + 1, 1 To c)
Ray(1, 1) = "Tag"
For Each k In Dic.keys
Rw = Rw + 1
For Each p In Dic(k)
Ac = .Item(p)(1): col = 0
For Each R In Dic(k).Item(p)(1)
Ray(1, Ac + col) = p
Ray(Rw + 1, 1) = k
Ray(Rw + 1, Ac + col) = R.Offset(, 1).Value
col = col + 1
Next R
Next p
Next k
End With
With Sheets("Sheet2").Range("A1").Resize(UBound(Ray, 1), UBound(Ray, 2))
.Value = Ray
.Borders.Weight = 2
.Columns.AutoFit
End With
End Sub