Expert: Tushar Sakhalkar - 6/11/2008

Question
QUESTION: I have a list of addresses with a blank line dividing one contact from the next.  I have included the example below.  Note that not all contacts have the same amount of lines.  I am currently using a macro that transposes the text every 5 lines but I need something that does every blank line and I don't know how to alter this.     

AAG - Club Empleados  
Av. Corrientes 538 piso 11
(1043) Capital Federal
4325-1113
4325-8660
handicap@aag.org.ar

ABRIL CLUB DE CAMPO
autopista BS AS- La Plata km 33,5
(1884) BERAZATEGUI
4215-4000 4342-6618/6620
starter@abrilclub.com.ar
www.abrilgolf.com.ar

AERO CLUB FORTIN LOBOS
RUTA NAC. Nš 205 KM. 106
(7240) LOBOS
02227-421700 02227-(15)613865
www.afl-golf.com.ar

This is how I would like the macro to respond with.  
AAG - Club Empleados     Av. Corrientes 538 piso 11    (1043) Capital Federal    4325-1113    4325-8660    handicap@aag.org.ar
ABRIL CLUB DE CAMPO    autopista BS AS- La Plata km 33,5    (1884) BERAZATEGUI    4215-4000 4342-6618/6620    starter@abrilclub.com.ar    www.abrilgolf.com.ar
AERO CLUB FORTIN LOBOS    RUTA NAC. Nš 205 KM. 106    (7240) LOBOS    02227-421700 02227-(15)613865    www.afl-golf.com.ar    

Please help

ANSWER: If -

A1 - AAG - Club Empleados  
A2 - Av. Corrientes 538 piso 11
A3- (1043) Capital Federal
A4 - 4325-1113
A5 - 4325-8660
A6 - handicap@aag.org.ar
A7 -
A8 - ABRIL CLUB DE CAMPO
A9 - autopista BS AS- La Plata km 33,5
A10- (1884) BERAZATEGUI
A11- 4215-4000 4342-6618/6620
A12- starter@abrilclub.com.ar
A13- www.abrilgolf.com.ar

Do you want (in another sheet)-
A1 = A1 SPACE A2 SPACE A3 SPACE A4 SPACE A5
A2 = A6
A3 = A8 SPACE A9 SPACE A10 SPACE A11 SPACE A12
A2 = A13

OR
A1 = A1; B1 = A2, C1 = A3, D1 = A4, E1 = A5, F1 = A6
B1 = A8; B2 = A9, C2 = A10, D2 = A11, E2 = A12, F2 = A13

Please let me know.
Accordingly I will write a MACRO for you.

Regards

---------- FOLLOW-UP ----------

QUESTION: This is the one.  
A1 = A1; B1 = A2, C1 = A3, D1 = A4, E1 = A5, F1 = A6
B1 = A8; B2 = A9, C2 = A10, D2 = A11, E2 = A12, F2 = A13

Thanks for the response!

Answer
try out the following macro-
(Two consecutive blank lnes will terminate the macro)

Sub transpos()
i = 1
For j = 1 To 65536
   If Not Cells(j, 1) = "" Then
      Sheets("Sheet2").Cells(i, 1) = Sheets("Sheet1").Cells(j + 1, 1)
      Sheets("Sheet2").Cells(i, 2) = Sheets("Sheet1").Cells(j + 2, 1)
      Sheets("Sheet2").Cells(i, 3) = Sheets("Sheet1").Cells(j + 3, 1)
      Sheets("Sheet2").Cells(i, 4) = Sheets("Sheet1").Cells(j + 4, 1)
      Sheets("Sheet2").Cells(i, 5) = Sheets("Sheet1").Cells(j + 5, 1)
      Sheets("Sheet2").Cells(i, 6) = Sheets("Sheet1").Cells(j + 6, 1)
      j = j + 6
      i = i + 1
   Else
       If Cells(j, 1) = "" And Cells(j + 1, 1) = "" Then
       Exit Sub
       End If
       
   End If




Next j

End Sub