Extraction de données d'un tableau Excel vers un autre

**benadry** · 02/12/2013, 09h12

Bonjour le forum,

J'ai créé une macro permettant d'extraire des données d'un classeur Excel nommé "Fiche anomalieV1.1.xlsm" vers un classeur Excel "Extraction.xlsx".

Je souhaite que la macro compte les lignes déjà utilisées et que les données soient copiées sur la première ligne vide du classeur de destination.
Donc la première série de données extraite sera placée dans les cellules A3:J3, la 2e dans les cellules A4:J4 ...

Pour ce faire, j'ai repris et bidouillé un code (à la fin du code à partir de With ActiveWorkbook.Sheets("Feuil1")). Mais, en combinant les deux, cela ne fonctionne pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Sub Macro1()
'
 
    Dim i As Long
    Dim cel As Range
    Dim pl As Range
 
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("A9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("A3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("B3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("C3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("D3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("E3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("F3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("G3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("H3").Select
    ActiveSheet.Paste
 
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("I3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("J3").Select
    ActiveSheet.Paste
 
    Range("A3:J3").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    Range("A3:J3").Select
    Selection.FormatConditions.Delete
 
    Range("A3:J3").Select
    Selection.Validation.Delete
 
    Range("A3:J3").Select
    Selection.ClearComments
 
 
    With ActiveWorkbook.Sheets("Feuil1")
    i = .UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
    For Each cel In pl
        cel.Copy .Cells(i + 1, 1)
        i = i + 1
    Next cel
    End With
 
    End Sub

Je pense que c'est très basique, mais je ne m'y connais pas beaucoup en macro.

Quelqu'un pourrait-il me donner un coup de main ?

Merci d'avance.

Cordialement.

**Marc-L** · 02/12/2013, 12h09

Bonjour,

tel que tu as utilisé UsedRange, c'est juste si et seulement si les données commencent en ligne 1 …

Sinon c'est idiot !
Car pour obtenir le numéro de la dernière ligne formatée - UsedRange ne se préoccupant pas que des saisies -
il faut en passer par la propriété Row :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    With ActiveWorkbook.Sheets("Feuil1")
        i = .UsedRange.Rows(.UsedRange.Rows.Count).Row + 1
    End With

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**benadry** · 02/12/2013, 13h31

Bonjour Marc-L,

Merci pour ta réponse.

Je n'ai peut-être pas tout compris, mais en intégrant ton code, je n'ai certes plus de bug, mais le contenu de la ligne remplie est systématiquement écrasé. La macro se place toujours sur la même ligne.
Or, je souhaite que les données se rajoutent, le tableau d'extraction allant chercher des données dans diverses fiches Excel.

Comment puis-je faire ?

Merci d'avance.

**Marc-L** · 02/12/2013, 13h39

En fait la ligne n°2 de mon code représente la première ligne "vide" à cause du + 1 …

Donc si tu retires ce + 1 c'est bien la dernière ligne utilisée.

Si cela ne fonctionne toujours pas, il faudrait alors que tu vérifies la logique de ton code …

Edit : la variable pl de la ligne n°109 est alimentée où ? …

**benadry** · 02/12/2013, 14h18

Re-,

Ca ne marche toujours pas, avec ou sans le + 1. Mais, j'ai sans doute compris de travers.

Mon code d'origine était :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
With ActiveWorkbook.Sheets("Feuil1")
    i = .UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
    For Each cel In pl
        cel.Copy .Cells(i + 1, 1)
        i = i + 1
    Next cel
    End With

Mon code actuel est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 With ActiveWorkbook.Sheets("Feuil1")
        i = .UsedRange.Rows(.UsedRange.Rows.Count).Row + 1
    End With

Le pl, issu d'un précédent code, faisait référence aux données que j'importais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
With Sheets("Feuil2")
Set pl = Application.Union(.Cells(8, 5), .Cells(9, 1), .Cells(9, 2), .Cells(9, 5), .Cells(13, 2), .Cells(15, 2), .Cells(15, 5), .Cells(17, 2), .Cells(17, 5))
End With

J'ai oublié quelque chose quelque part, mais où ?

**Marc-L** · 02/12/2013, 14h24

Effectivement, il n'y a pas de Set pl = dans ton code …

**benadry** · 02/12/2013, 18h41

Désolé de ne pas avoir répondu plus tôt.

J'ai remis le Set pl=, mais ça ne va pas mieux.

Voici mon code global pour être plus clair :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Sub Macro1()
'
 
    Dim i As Long
    Dim cel As Range
    Dim pl As Range
 
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("A9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("A3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("B3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("C3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("D3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("E3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("F3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("G3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("H3").Select
    ActiveSheet.Paste
 
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("I3").Select
    ActiveSheet.Paste
 
    Windows("Fiche anomalieV1.1.xlsm").Activate
    Range("E17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Extraction.xlsx").Activate
    Range("J3").Select
    ActiveSheet.Paste
 
    Range("A3:J3").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    Range("A3:J3").Select
    Selection.FormatConditions.Delete
 
    Range("A3:J3").Select
    Selection.Validation.Delete
 
    Range("A3:J3").Select
    Selection.ClearComments
 
    With Sheets("Feuil2")
    'définit la plage pl des données que l’on veut importer
    Set pl = Application.Union(.Cells(8, 5), .Cells(9, 1), .Cells(9, 2), .Cells(9, 5), .Cells(13, 2), .Cells(15, 2), .Cells(15, 5), .Cells(17, 2), .Cells(17, 5))
    End With
 
 
   With ActiveWorkbook.Sheets("Feuil1")
        i = .UsedRange.Rows(.UsedRange.Rows.Count).Row + 1
    For Each cel In pl
        cel.Copy .Cells(i + 1, 1)
        i = i + 1
    Next cel
    End With
 
    End Sub

La macro écrit toujours sur la même ligne et écrase donc à chaque fois les données précédentes !

Help !!

**Marc-L** · 03/12/2013, 02h19

C'est si énorme que je l'ai laissé passer ‼

Code à revoir, toutes les destinations de copie sont fixes comme par exemple la ligne n°14 …

**Momo_Ouzz** · 20/09/2019, 11h40

Bonjour à tous,

J'ai un petit soucis je cherche à appliquer depuis quelques jours une macro (via un bouton) à mon fichier afin de pouvoir extraire les informations du tableau si la colonne G contient le chiffre 90 vers la feuille Réf Inactive à partir de la cellule A7.

Etant novice en VBA je n'ai pas la moindre idée de comment m'y prendre, j’espère que cela est réalisable en tout cas je compte voir comment est structuré le code car c'est une macro que je vais sans doute utiliser pour différent fichier.

Merci d'avance pour votre aide.( je suis un peu perdu sur le sujet). TEST.xlsx

Extraction de données d'un tableau Excel vers un autre

Macros et VBA Excel

Discussions similaires

Partager

Partager