Macro to combine rows with common data and delete duplicates

Sub test()
    Dim a, i As Long, ii As Long, w
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                ReDim w(1 To UBound(a, 2)): .Item(a(i, 1)) = w
            Else
                w = .Item(a(i, 1))
            End If
            For ii = 1 To UBound(a, 2)
                If a(i, ii) <> "" Then w(ii) = a(i, ii)
            Next
            .Item(a(i, 1)) = w
        Next
        w = Application.Index(.items, 0, 0)
    End With
    With Sheets("sheet2").Cells(1).Resize(UBound(w, 1), UBound(w, 2))
        .CurrentRegion.ClearContents
        .Value = w
    End With
End Sub

Sub test()
    Dim a, i As Long, ii As Long, w
    a = Sheets("sheet1").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = .Count + 2
                For ii = 1 To UBound(a, 2)
                    a(.Count + 1, ii) = a(i, ii)
                Next
            Else
                For ii = 1 To UBound(a, 2)
                    If a(i, ii) <> "" Then a(.Item(a(i, 1)), ii) = a(i, ii)
                Next
            End If
        Next
        i = .Count + 1
    End With
    With Sheets("sheet2").Cells(1).Resize(i, UBound(a, 2))
        .CurrentRegion.ClearContents
        .Columns(1).NumberFormat = "@"
        .Value = a
    End With
End Sub