Okay - try this:
Option Explicit
Public Sub NormaliseData()
Dim rngSource, rngDest As Range
Dim intRow As Integer
Dim strSourceSheet As String
Dim strDestSheet As String
strSourceSheet = "Sheet5"
strDestSheet = "Sheet6"
Worksheets(strSourceSheet).Select
For intRow = 1 To Worksheets(strSourceSheet).UsedRange.Rows.Count
If Worksheets(strSourceSheet).Range("A" & intRow).Value Like "a" Then
If intRow = 1 Then
Set rngSource = Worksheets(strSourceSheet).Range("A" & intRow & ":D" & intRow + 2)
Else
Set rngSource = Worksheets(strSourceSheet).Range("B" & intRow & ":D" & intRow + 2)
End If
Call fncTranspose(rngSource, rngDest, intRow, strDestSheet)
End If
Next intRow
MsgBox "Values have been transposed", vbOKOnly, "Transposed"
End Sub
Function fncTranspose(rngSource, rngDest, intRow, strDestSheet)
Dim intLastDestRow As Integer
intLastDestRow = Worksheets(strDestSheet).UsedRange.Rows.Count
Worksheets(strDestSheet).Select
If intRow = 1 Then
Set rngDest = Worksheets(strDestSheet).Range("A" & intLastDestRow)
rngSource.Copy
rngDest.PasteSpecial Transpose:=True
Else
Set rngDest = Worksheets(strDestSheet).Range("A" & intLastDestRow + 1)
rngSource.Copy
rngDest.PasteSpecial Transpose:=True
End If
End Function