Macro extraction données Excel

Version imprimable

19/10/2014, 22h55
Samexcel

1 pièce(s) jointe(s)

Macro extraction données Excel

Bonjour,
D’abord je m’excuse pour ma question, je suis sûre que la question a déjà été posée et une réponse déjà fournie, le fait est que j’ignore tous des Macros et du VBA.
Le fichier ci-joint est rempli quotidiennement avec la date du Jour. En gros, c’est la même feuille Excel qui se répète 65 fois (avec des données différentes pour chaque numéro de paquet).
Y aurait-il un moyen d’extraire les données qui apparaissent dans l'onglet "Borderaux" entre la cellule c7- c41 (paquet#1), M7-M41 Paquet#2, W7-W41 paquet#3…etc.
Les données devront être copiées dans l'onglet extraction. l'extraction devra bien sûre ignorer/Skipper les cellules vides.

Merci pour votre aide.

Bonsoir Samexcel, bonsoir le forum,

Peut=être comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Macro1()
Dim B As Object 'déclare la variable B (onglet Bordereaux)
Dim E As Object 'déclare la variable E (onglet Extraction)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Byte 'déclare la variable I (Incrément)
Dim TR() As Variant 'déclare le tableau de variables indéxées TR (Tableau des Résultats)
Dim J As Long 'déclare la variable J (incrément)
 
Set B = Sheets("Borderaux") 'définit l'onglet B
Set E = Sheets("Extraction") 'définit l'onglet E
For COL = 3 To 643 Step 10 'boucle 1 : sur les colonnes 3 à 643 par pas de 10
    TC = B.Range(B.Cells(7, COL), B.Cells(41, COL)) 'définit le tableau de cellules TC
    For I = 1 To UBound(TC) 'boucle 2 : sur toutes les cellules du tableau TC
        If TC(I, 1) <> "" Then 'condition : si la cellule n'est pas vide
            ReDim Preserve TR(J) 'redimensionne le tableau des résultats TR
            TR(J) = TC(I, 1) 'récupère dans la variable indexée J du tableau TR la valeur de la cellule TC(I,1)
            J = J + 1 'incrémente J
        End If 'fin de la condition
    Next I 'prochaine cellule de la boucle 2
Next COL 'prochaine colonne de la boucle 1
E.Range("A1").Resize(J) = Application.Transpose(TR) 'renvoie les résultats dans la colonne A  de l'onglet E à partir de A1
End Sub

20/10/2014, 14h20
Samexcel

Merci Thauthème, c'est parfait.
J'ai fait plusieurs tests, et l'extraction est complète.
encore Merci!

Une autre question SVP.
Supposons que j’ajoute 3 nouveaux onglets à mon classeur. « Bordereaux1 », « Bordereaux2 » et « Bordereaux3 ». ces trois onglets auront les mêmes dispositions, format et mise en forme de l’onglet « Bordereaux »
Quel code dois-je ajouter à ma macro pour que les données des nouvelles feuilles soient aussi copier dans l’onglet extraction?
Bordereaux1 : sous colonne B de l’onglet extraction
Bordereaux2 : sous colonne C de l’onglet extraction
Bordereaux3 : sous colonne D de l’onglet extraction

Merci

Bonjour Samexel, bonjour le forum.

Essaie comme ca (non testé) :

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
Sub Macro1()
Dim B(1 To 3) As Object 'déclare le tableau de variable B (onglets Bordereaux)
Dim E As Object 'déclare la variable E (onglet Extraction)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Byte 'déclare la variable I (Incrément)
Dim TR() As Variant 'déclare le tableau de variables indéxées TR (Tableau des Résultats)
Dim J As Long 'déclare la variable J (incrément)
Dim Z As Byte 'déclare la variable Z (incrément)
 
Set B(1) = Sheets("Borderaux1") 'définit l'onglet B(1)
Set B(2) = Sheets("Borderaux2") 'définit l'onglet B(2)
Set B(3) = Sheets("Borderaux3") 'définit l'onglet B(3)
Set E = Sheets("Extraction") 'définit l'onglet E
For Z = 1 To 3 'boucle 1 : sur les 3 onglets "Bordereaux"
    I = 0: J = 0 'réinitialise les variable I et J
    For COL = 3 To 643 Step 10 'boucle 2 : sur les colonnes 3 à 643 par pas de 10
        TC = B(Z).Range(B(Z).Cells(7, COL), B(Z).Cells(41, COL)) 'définit le tableau de cellules TC
        For I = 1 To UBound(TC) 'boucle 3 : sur toutes les cellules du tableau TC
            If TC(I, 1) <> "" Then 'condition : si la cellule n'est pas vide
                ReDim Preserve TR(J) 'redimensionne le tableau des résultats TR
                TR(J) = TC(I, 1) 'récupère dans la variable indexée J du tableau TR la valeur de la cellule TC(I,1)
                J = J + 1 'incrémente J
            End If 'fin de la condition
        Next I 'prochaine cellule de la boucle 3
    Next COL 'prochaine colonne de la boucle 2
    E.Cells(1, Z + 1).Resize(J) = Application.Transpose(TR) 'renvoie les résultats dans la colonne A  de l'onglet E à partir de A1
Next Z 'prochain onglet de la boucle 1
End Sub

20/10/2014, 20h14
Samexcel

Bonjour Thautheme,
Tests effectués et ça fonctionne parfaitement!
Merci beaucoup, j'apprécie votre aide.