pbl creation macro

Version imprimable

27/07/2007, 16h13
jce64

1 pièce(s) jointe(s)

pbl creation macro

Bonjour,
j'ai un problème sur un fichier excel, j'ai une lliste de plus de 15000 lignes que je dois arranger dans un tableau organisé en nom, adresse, date naissance, lieu, code 1, code2. Je ne sais comment programmer automatiquement ce travail très long et factidieux et répétitif.
Par exemple je dois copier ou coller
A14 vers A8
C12 vers C8
C13 vers D8
E12 vers H8
E13 vers I8
J12 vers J8
K12 vers K8
et ainsi de suite
C19 vers A9
C17 vers C9
C18 vers D9
E17 vers H9
E18 vers I9
J18 vers J9
K18 vers K9
et ainsi jusqu'à la fin du fichier de 5580 noms
Auriez vous une solution pour automatiser ce travail ?
il est possible d'effacer les lignes qui ont été copièes au fur et à mesure également.
Merci pour votre aide.
Sincères salutations

Bonjour
Si ton fichier est formatée, c'est à dire que les écarts entre chaque adresse sont identiques alors:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Dim A As Integer ' ligne à lire
Dim I As Integer ' ligne de destination
A = 8 'initialisation
I = 14 'initialisation
Do While Cells(I, 1) <> "" 'on boucle tant qu'il y a du monde dana la cellule
    'Ensuite on copie cellule par cellule
    Cells(A, 1) = Cells(I, 1)
    If Left(Cells(I - 2, 3), 3) = "Mme" Then
        Cells(A, 2) = "Mme"
        Cells(A, 3) = Right(Cells(I, 2), Len(Cells(I, 2)) - 4)
    Else
        Cells(A, 2) = "M."
        Cells(A, 3) = Right(Cells(I, 2), Len(Cells(I, 2)) - 3)
    End If
    'et ainsi de suite
    A = A + 1
    I = I + 5
Loop

Si tu rencontre des soucis, n'hésites pas
Slts

27/07/2007, 21h36
jce64

1 pièce(s) jointe(s)

creation macro suite

Merci pour votre réponse, mais je suis nul en programmation et juste un utilisateur basique sur Excel.
Donc je ne sais pas trop quoi faire avec le programme que vous m'avez envoyé, mes essais sont infructueux.
Aussi je vous envoi une partie de mon fichier, si vous pouviez me le renvoyer avec le VBA et m'indiquer la manip que je dois faire pour le reste du fichier cela serait super.
Par la même occasion pourriez vous me conseillez un cours sur internet ou un bon livre pour essayer d'apprpendre le langage VBA.
Sincèrement merci pour votre réponse.
JC
28/07/2007, 12h44
Plateforme3

Bonjour
Il me faudrait un fichier un peu pllus complet intégrant tous les cas de figure
Par exemple, dans celui là, je n'ai pas de cas "Adresse 2"
Slts
28/07/2007, 15h09
zazaraignée

Que cherches-tu à faire, au juste ? des étiquettes pour envois postaux ?
28/07/2007, 22h39
jce64

1 pièce(s) jointe(s)

pbl macro suite

Merci pour vos réponses.
je cherche à faire un fichier qui permettrat par la suite de faire des tris et pourquoi pas des envois de courrier.
Je joins un fichier plus complet.
Dans tous les cas merci de votre aide.
Cordialement
JC

ci dessous le fichier que tu nous a envoyé avec le code qui fait le traitement que tu souhaites.
Pour le lancer, tu fais ALT + F8 et choisi la macro "Feuil1.création_liste"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Public Sub création_liste()
Dim i As Long
Dim j As Long
 
Dim stNom() As String
 
j = 4
'Reccherche la première ligne dispo
Do While Range("A" & j).Value <> ""
    j = j + 1
Loop
 
For i = 10 To 65000
 
    'Ajoute un enregistrement si on rencontre un numéro
    If Range("A" & i).Value <> "" Then
        'Copie les éléments
        Range("A" & j).Value = Range("A" & i).Value
        stNom = Split(Range("C" & i - 2).Value, " ")
        Range("B" & j).Value = stNom(0)
        Range("C" & j).Value = Trim(Mid(Range("C" & i - 2).Value, Len(stNom(0)) + 1, Len(Range("C" & i - 2).Value)))
        Range("D" & j).Value = Range("C" & i - 1).Value
        stNom = Split(Range("C" & i).Value, " ")
        Range("F" & j).Value = stNom(0)
        Range("G" & j).Value = UCase(stNom(1))
        Range("H" & j).Value = Range("E" & i - 2).Value
        Range("I" & j).Value = Range("E" & i - 1).Value
        Range("J" & j).Value = Range("J" & i - 1).Value
        Range("K" & j).Value = Range("K" & i - 1).Value
 
        'efface l'adresse en pavé
        Rows(i - 3).Clear
        Rows(i - 2).Clear
        Rows(i - 1).Clear
        Rows(i).Clear
 
        j = j + 1
 
    End If
 
Next i
 
End Sub

Le fichier
Pièce jointe 17234