Transpose Excel data from rows to columns

Hello I have Data like below image , i need Transpose Excel data from rows to columns with base Column A , Mean if the column A are same do that .
If you see the image you can understand fully . If you can provide a VBA for this really will help me so much . (Important :I need do for the row that their A column Are same )
The data that i have are till I column .

Attachment 21174

I have the below code but it is only work on column B i need do the same From B To I Column

Code:

---

Option Explicit
Sub Test()
    Dim a, i As Long, y, w()
    a = ThisWorkbook.Sheets("Sheet1").Range("a1").CurrentRegion.Resize(, 2).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                .Add a(i, 1), Array(a(i, 1), a(i, 2))
            Else
                w = .Item(a(i, 1))
                ReDim Preserve w(UBound(w) + 1)
                w(UBound(w)) = a(i, 2)
                .Item(a(i, 1)) = w
            End If
        Next
        y = .items
    End With
    With ThisWorkbook.Sheets("Sheet2").Range("a1")
        .CurrentRegion.Clear
        For i = 0 To UBound(y)
            .Offset(i).Resize(, UBound(y(i)) + 1).Value = y(i)
        Next
    End With
End Sub

---

Code:

---

Sub blah()
Set SourceRng = Sheets("Sheet1").Range("A1").CurrentRegion
Set DestnRng = Sheets("Sheet2").Range("A1")
With SourceRng
  .Columns(1).Copy DestnRng
  Intersect(.Offset(0, 0), .Offset(, 1)).Copy
  DestnRng.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
  Application.CutCopyMode = False
End With
End Sub

---

?
(No clearing of the destination cells.)

Hello , Thanks for your help but it is not my mean , if you check the attached image you understand what i need .

Point out the differences:
Attachment 21179
After my offering:
Attachment 21180

Hello , Please check the attached Excel File , in Sheet 2 is our result , if you see it you will understand .

Attachment 21182

Ahh, moving goalposts again.
Try these two (only run blah, it calls the other):

Code:

---

Sub blah()
Set mydata = Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
Set Destn = Sheets("Sheet2").Range("A1")
mydatavals = mydata.Value
Count = 1: StartBlock = 1
For i = 1 To UBound(mydatavals) - 1
  If mydatavals(i, 1) = mydatavals(i + 1, 1) Then
    Count = Count + 1
  Else
    MoveStuff mydata.Cells(StartBlock, 1).Resize(Count, 9), Destn
    Set Destn = Destn.Offset(8)
    StartBlock = StartBlock + Count: Count = 1
  End If
Next i
MoveStuff mydata.Cells(StartBlock, 1).Resize(Count, 9), Destn
End Sub

Sub MoveStuff(SourceRange, DestnRange)
DestnRange.Resize(8, 1).Value = SourceRange.Cells(1).Value
Intersect(SourceRange, SourceRange.Offset(, 1)).Copy
DestnRange.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub

---

(No clearing of the destination cells.)

Really appreciate for your great help .