Code:
Option Explicit
Sub Rasporedi()
' Rasporedjuje vrednosti iz kolone A na aktivnom listu
' U tabelu sa cetiri kolone na izabranom odredištu
' P.Jovanvovic za elitesecurity.org

Dim rngSource As Range
Dim rngDest As Range
Dim strNatpis As String
Dim DefRng As String
Dim i As Integer
Dim r As Integer, rstop As Integer
Dim c As Byte
' Izvorni podaci
On Error Resume Next
DefRng = Range("A4", Range("A4").End(xlDown).Address).Address
Set rngSource = Application.InputBox(Prompt:="Selektuj izvorne podatke", Title:="Range Select", Default:=DefRng, Type:=8)
If rngSource Is Nothing Then Exit Sub
If rngSource.Rows.Count Mod 4 > 0 Or _
  rngSource.Columns.Count > 1 Then
   MsgBox "Nesipravan izvorni opseg"
   Exit Sub
End If
' Odredište - samo gornja leva celija!
Set rngDest = Application.InputBox(Prompt:="Selektuj poèetnu æeliju za odrediste", Title:="Range Select", Type:=8)
If rngDest Is Nothing Then
  Exit Sub
End If

On Error GoTo 0
Set rngDest = rngDest.Resize(RowSize:=1, ColumnSize:=1)  ' Skracivanje izabranog opsega na samo jednu æeliju
rstop = rngSource.Rows.Count / 4 - 1
Set rngSource = rngSource.Cells(1, 1)
For r = 0 To rstop
      strNatpis = rngSource.Text
      rngDest.Offset(RowOffset:=r, ColumnOffset:=0).Value = strNatpis
   If UCase(Trim(strNatpis)) = "UKUPNO" Then
      c = 0
   Else
      c = 1
   End If
   For i = 1 To 3
      rngDest.Offset(RowOffset:=r, ColumnOffset:=i + c).Value = rngSource.Offset(RowOffset:=i).Value
   Next i
   Set rngSource = rngSource.Offset(RowOffset:=4)
Next r

End Sub