Erro no Loop e layout de arquivo txt incompleto

Caros, venho mais uma vez solicitar a ajuda de vocês.
Preciso que a saída de meu arquivo (.txt) ao ser exportado seja conforme abaixo:

1 - O cabeçalho deve listar apenas no começo;
2 - As informações devem estar agrupadas por clientes. Pode ser que dentro do mesmo cliente tenha UCs diferentes, logo devem estar listadas conforme exemplo do cliente nº2.

No aguardo de vossas contribuições.

100;CartasCobrança
A200;123132
A300;05/12/2017
A400;0800-123-123
A500;João xyz
A600;Departamento Y
A700;Divisão X

B100;101212
B300;EDISON lulalala
B200;88557788
C100;CONS CARRAO
C200;999
C300;
C400;CURITIBA
D100;30899869
D200;PARAGUASSU
D300;33
D400;AP x
D500;80030-000
D600;CURITIBA
E300;117,21

.... (próximo cliente)

B100;1122233
B300;VANESSA lulalala
B200;99887766;66778899
C100;JOSE RAIMUNDO MAGALHAES
C200;102
C300;
C400;SARANDI
D100;94566933
D200;MAMORE
D300;500
D400;QD  x
D500;87112-000
D600;SARANDI
E300;117,74


Segue parte do código utilizado, porém o modelo (resumo) do que preciso está em anexo.

Do While Lista.EOF = False
   
       Lista.MoveFirst
       
   ts.WriteLine A100
   ts.WriteLine B
   ts.WriteLine C
   ts.WriteLine D
   ts.WriteLine E
   ts.WriteLine F
   ts.WriteLine G

   'DADOS DE IDENTIFICAÇÃO DO CLIENTE
   ts.WriteLine
   ts.WriteLine H
   ts.WriteLine J
   ts.WriteLine i

   'ENDEREÇO DAS UCS DEBITOS
   ts.WriteLine R
   ts.WriteLine S
   ts.WriteLine T
   ts.WriteLine U
   
   'ENDEREÇO DE ENVIO
   ts.WriteLine V
   ts.WriteLine X
   ts.WriteLine Y
   ts.WriteLine Z
   ts.WriteLine W
   ts.WriteLine AA
   
   'DÉBITOS
   ts.WriteLine M

     Lista.MoveNext
   
   Loop
   
       ts.WriteLine A999
   
   ts.Close
   
   SS = "Arquivo Gerado na pasta " & arq3
   MsgBox SS