traitement de fichier XLS/ macro vba

Version imprimable

15/07/2012, 10h31
yodsilva

1 pièce(s) jointe(s)

traitement de fichier XLS/ macro vba

bonjour ,

jeune gestionnaire en stage , je souhaite écrire une macro m'aidant a extraire des données d"un fichier excel a partir d'un onglet et les mettre dans un autre onglet de la meme feuille ( constituant un onglet de donnees qui seront ensuite integre dans une base de données) ; j'ai lancé l'enregistreur pour ecrire la macro mais elle reste imprécise par rapport a la finalite
pouvez vous m'aider ?

ci-joint le fichier xls de travail , le premier onglet devrait varier(données) et le second devrait etre rempli par les données d'un premier onglet.

Merci pour votre concours a tous,

Bonjour,
Essaie cette macro (la feuille "DB" est remplie seulement jusqu'à la colonne G). Si ça te convient, je t'ajouterai les explications.

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
Sub Copie()
    Dim Ligne As Long, Sh As Worksheet, C As Range, ResAdr As String, Ctr As Integer
    Set Sh = Sheets("DB")
    With Sheets("HOLX_RAXINV_SEL_46907766_1")
        .Select
        .[A1].Select
        Set C = .[E:E].Find("INVOICE", , , xlWhole, , True)
        If Not C Is Nothing Then
            ResAdr = C.Address
            Do
                Ligne = Sh.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
                Sh.Cells(Ligne, 1) = C.Offset(2)
                Sh.Cells(Ligne, 2) = C.Offset(4)
                Sh.Cells(Ligne, 3) = C.Offset(6)
                Sh.Cells(Ligne, 4) = C.Offset(8)
                Sh.Cells(Ligne, 5) = C.Offset(10)
                Sh.Cells(Ligne, 6) = C.Offset(4, 1)
                Ctr = 0
                For i = C.Row + 12 To .Cells(C.Row + 11, 1).End(xlDown).Row
                    Sh.Cells(Ligne, 7).Offset(Ctr) = .Cells(i, 1)
                    Ctr = Ctr + 1
                Next i
                Set C = .[E:E].FindNext(C)
            Loop While C.Address <> ResAdr
        End If
    End With
End Sub

16/07/2012, 20h39
yodsilva

1 pièce(s) jointe(s)

bonjour ,

merci beaucoup pour votre reponse ca me touche que quelqu'un me reponde de cette océan qu'est internet
vous trouverez ci-joint les précisions de mon besoin

merci encore de votre concours a tous
ce code pourrais me permettre d' avoir mon premier contrat de travail ; en cette periode de crise économique toute aide expert est la bienvenue
16/07/2012, 20h56
yodsilva

traitement fichier excel / macro vba

si vous avez une autre solution pour remplir l'onglet DB je suis preneur; l'idée est de copier les informations des cellules vertes
factures par factures ; chaque facture étant bornées pour les lignes
Ligne début : colonne A case commençant par “35 Crosby Drive”
Ligne fin : colonne A case commençant par “17. WAIVER”
17/07/2012, 10h12
Daniel.C

1 pièce(s) jointe(s)

Bonjour,

Citation:

vous trouverez ci-joint les précisions de mon besoin

Ce n'est pas trop l'habitude du forum de faire ce genre de choses. D'autant que ça représente pas mal de travail. Je veux bien cependant essayer à temps perdu. Quel est ton niveau de connaissances Excel et VBA ? parce que, si tu es débutant, je ne vois pas en quoi une belle appli peut t'aider.

Regaarde le classeur joint. Le traitement a été fait pour les colonnes A à G de la feuille DB. Dis-moi si cc'est correct
18/07/2012, 22h19
yodsilva

1 pièce(s) jointe(s)

retour fichier

encore merci encore pour le temps passe sur ma demande ; pour repondre a tes precedents mails je suis debutant en programmation l'idee de mon projet c'est de constituer un fichier excel struturer pour creer une base de donnee des factures afin de faciliter le controle
pour ce qui est de ton retour j'ai insere quelque indication ds l'onglet HOLX_RAXINV_SEL_46907766_1 et le traitement donnant les infos en vert son excellentes ce sont les infos attendu de la colonne A à G pour chaque facture (HOLX_RAXINV_SEL_46907766_1) ; il faudrait avoir les infos en vert uniquement facture par facture

merci a vous
19/07/2012, 17h06
Daniel.C

1 pièce(s) jointe(s)

Regarde le classeur. Il y a des zones en vert que je n'ai pas su recopier. Peux-tu me préciser pour chacune quelle est la colonne des destination ?
30/07/2012, 22h45
yodsilva

1 pièce(s) jointe(s)

retour 3 fichier

bonjour ,

pour le silence , j'étais malade ci -joint le fichier avec pour chaque colonne de l'onglet DB les cellules sources du premier onglet
j'espere avoir ete claire
merci encore pour ton aide

a+

1 pièce(s) jointe(s)

Bonjour,

Pas de problème, ici, on répond quand on est disponible. Bon rétablissement. La macro est la suivante :

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub Copie()
    Dim Ligne As Long, Sh As Worksheet, C As Range, ResAdr As String, Ctr As Integer
    Set Sh = Sheets("DB")
    With Sheets("HOLX_RAXINV_SEL_46907766_1")
        Set C = .[E:E].Find("INVOICE", .[E65000], , xlWhole, , True)
        If Not C Is Nothing Then
            ResAdr = C.Address
            Ligne = Sh.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
            Sh.Cells(Ligne, 1) = C.Offset(2)
            Sh.Cells(Ligne, 2) = C.Offset(4)
            Sh.Cells(Ligne, 3) = C.Offset(6)
            Sh.Cells(Ligne, 4) = C.Offset(8)
            Sh.Cells(Ligne, 5) = C.Offset(10)
            Sh.Cells(Ligne, 6) = C.Offset(4, 1)
            ' bill to
            Ctr = 0
            For i = C.Row + 12 To .Cells(C.Row + 11, 1).End(xlDown).Row
                Sh.Cells(Ligne, 7).Offset(Ctr) = .Cells(i, 1)
                Ctr = Ctr + 1
            Next i
            ' ship to
            Ctr = 0
            For i = C.Row + 12 To .Cells(C.Row + 11, 3).End(xlDown).Row
                Sh.Cells(Ligne, 8).Offset(Ctr) = .Cells(i, 3)
                Ctr = Ctr + 1
            Next i
            Sh.Cells(Ligne, 9) = .[A:A].Find("Terms", , , xlWhole).Offset(1)
            Sh.Cells(Ligne, 10) = .[A:A].Find("Terms", , , xlWhole).Offset(1, 2)
            Sh.Cells(Ligne, 11) = .[A:A].Find("Terms", , , xlWhole).Offset(1, 3)
            Sh.Cells(Ligne, 12) = .[A:A].Find("Terms", , , xlWhole).Offset(3, 3)
            Sh.Cells(Ligne, 13) = .[G23]
            Sh.Cells(Ligne, 14) = .[G25]
            Sh.Cells(Ligne, 15) = .[A25]
            Sh.Cells(Ligne, 16) = .[A27]
            Sh.Cells(Ligne, 17) = .[D27]
            Ctr = 0
            For i = 31 To .[B31].End(xlDown).Row
                Sh.Cells(Ligne, "R").Offset(Ctr) = .Cells(i, 2)
                Ctr = Ctr + 1
            Next i
            Ctr = 0
            For i = 31 To .[D31].End(xlDown).Row
                If .Cells(i, 4) <> "" Then Sh.Cells(Ligne, "S").Offset(Ctr) = .Cells(i, 4)
                Ctr = Ctr + 1
            Next i
            Ctr = 0
            For i = 31 To .[F31].End(xlDown).Row
                If .Cells(i, 6) <> "" Then Sh.Cells(Ligne, "T").Offset(Ctr) = .Cells(i, 6)
                Ctr = Ctr + 1
            Next i
            Ctr = 0
            For i = 31 To .[H31].End(xlDown).Row
                If .Cells(i, "H") <> "" Then Sh.Cells(Ligne, "U").Offset(Ctr) = .Cells(i, "H")
                Ctr = Ctr + 1
            Next i
            Ctr = 0
            For i = 31 To .[J31].End(xlDown).Row
                If .Cells(i, "J") <> "" Then Sh.Cells(Ligne, "V").Offset(Ctr) = .Cells(i, "J")
                Ctr = Ctr + 1
            Next i
            Sh.Cells(Ligne, "W") = .[C37]
            Sh.Cells(Ligne, "X") = .[E37]
            Sh.Cells(Ligne, "Y") = .[G37]
            Sh.Cells(Ligne, "Z") = .[I37]
            Sh.Cells(Ligne, "AA") = .[C23]
            Sh.Cells(Ligne, "AB") = .[F11]
            Sh.Cells(Ligne, "AC") = .[F5]
        End If
    End With
End Sub

Je mettrai les commentaires quand elle sera finalisée. Je joins également le classeur avec les résultats (ceux-ci se sont mis en dessous de tes explications.