Sub aTest()
Dim dic As Object, sh As Variant, strKey As String
Dim vData As Variant, i As Long, lCounter As Long, vAux As Variant
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
lCounter = 0
For Each sh In Array("Sheet1", "Sheet2", "Sheet3") '<--Adjust sheet names
With Sheets(sh)
vData = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For i = LBound(vData, 1) To UBound(vData, 1)
strKey = vData(i, 1) & "|" & vData(i, 2) & "|" & vData(i, 3)
If dic.exists(strKey) Then
vAux = dic(strKey)
vAux(lCounter) = vData(i, 4)
vAux(lCounter + 1) = vData(i, 5)
dic(strKey) = vAux
Else
Select Case lCounter
Case 0
dic(strKey) = Array(vData(i, 4), vData(i, 5), "", "", "", "")
Case 2
dic(strKey) = Array("", "", vData(i, 4), vData(i, 5), "", "")
Case 4
dic(strKey) = Array("", "", "", "", vData(i, 4), vData(i, 5))
End Select
End If
Next i
End With
lCounter = lCounter + 2
Next sh
With Sheets("Master") '<--adjust sheet name
.Columns("A:I").ClearContents
.Range("A1:I1").Value = Array("State", "DOC", "Type", "Begin 1", "End 1", "Begin 2", "End 2", "Begin 3", "End 3")
.Range("A2").Resize(dic.Count).Value = Application.Transpose(dic.keys)
For i = 2 To dic.Count + 1
.Range("D" & i).Resize(, 6) = dic(.Range("A" & i).Value)
Next i
.Range("A2").Resize(dic.Count).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
OtherChar:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
End With
End Sub