Boucles et copier/coller VBA

Version imprimable

28/07/2016, 10h46
Lyricslife

Boucles et copier/coller VBA

Bonjour à tous !

Nouveau sur le forum, je fais appel à votre générosité, chers membres, pour venir en aide à l'étudiant que je suis, en galère depuis quelques jours maintenant...

Voilà le topo :
chaque semaine, dans le cadre de mon stage, je dois extraire des données de différents classeurs pour les compiler dans un seul. Vous allez me dire, ce n'est qu'un simple copier/coller à automatiser ! Sauf que...
Je dispose de 9 fichiers (AL_INT, AL_PRE, AL_REN, CH_INT, CH_PRE_CH_REN, LO_INT, LO_PRE, LO_REN) réunis dans un même dossier. Ce que je souhaiterais faire, c'est que lorsqu'il s'agit, par exemple, d'un fichier dont le nom comprend "INT", Excel sélectionne les cellules non-vides et les colle sur l'onglet "INT" de mon classeur principal. De même pour les fichiers "PRE" et les fichiers "REN". Autrement dit, sur mon classeur principal, l'onglet "INT" comprendra les données des 3 classeurs dont les noms contiennent "INT", l'onglet "REN" les données des 3 classeurs dont les noms contiennent "REN" et l'onglet "PRE" les données des 3 classeurs dont les noms contiennent "PRE". Sachant que chaque classeur du même nom a la même structure (le même nombre de colonnes) mais que le nombre d'observations (nombre de lignes) est variable d'une semaine à l'autre.
Pour la macro, il faudrait donc qu'Excel ouvre les différents classeurs, sélectionne la plage de cellules non-vides et la colle sous l'onglet qui correspond au nom du classeur.

J'ai déjà testé plusieurs solutions, notamment avec le CurrentRegion mais, débutant en VBA, j'avance à pas de fourmis...

Un grand merci à quiconque m'apportera son aide précieuse :)
28/07/2016, 11h06
halaster08

Bonjour,

Citation:

d'un fichier dont le nom comprend "INT",

Fait une recherche sur l'opérateur "like"

Citation:

Pour la macro, il faudrait donc qu'Excel ouvre les différents classeurs

Trouvé directement sur l'aide de microsoft pour ouvrir tous les fichiers d'un répertoire
https://support.microsoft.com/fr-fr/kb/466517

Citation:

l'onglet "INT" comprendra les données des 3 classeurs

Pour trouver la dernière cellule non vide de la colonne A:

Code:

Range("A" & Rows.Count).End(xlUp).Row

Tu pourras coller sans écrasé les données précédentes
28/07/2016, 11h10
Marc-L

Bonjour,

commencer par lire les règles du forum !

Ensuite poster un code balisé via l'icône dédiée (y a même une démonstration pour les moins doués dans ces règles !)
en précisant la difficulté technique rencontrée …

Ne pas oublier l'Enregistreur de macros, l'ami du débutant livrant une base de code sur un plateau !
Sans compter les tutoriels comme la FAQ à disposition sur ce forum …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …
28/07/2016, 11h17
Menhir

L'enregistreur automatique de macro pourra te fournir un code tout prêt, excepté pour déterminer la taille des zones non vides.
Pour ça, tu pourras utiliser la la propriété End de Range.
https://msdn.microsoft.com/fr-fr/lib.../ff839539.aspx

Merci beaucoup pour vos réponses très rapides !

J'ai finalement réussi à sortir un code qui fonctionne mais qui est lourd et peu "élégant".
Je vais encore approfondir mes recherches sur les boucles et l'opérateur "like".

Ci-dessous mon code

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
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
 
Sub test()
 
Dim wb As Workbook, wb1 As Workbook
Dim repertoire As String
 
repertoire = "D:\Test\Donnees\"
 
 
Set wb = ThisWorkbook
 
Set wb1 = Workbooks.Open(repertoire & "AL_INT.xls")
    wb1.Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("INT").Activate
    Range("A1").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "AL_PRE.xls")
    wb1.Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("PRE").Activate
    Range("A1").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "AL_REN.xls")
    wb1.Activate
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("GLO-REN").Activate
    Range("A1").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "CH_INT.xls")
    wb1.Activate
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("INT").Activate
    Range("A65000").End(xlUp).Offset(1).Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "CH_PRE.xls")
    wb1.Activate
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("PRE").Activate
    Range("A65000").End(xlUp).Offset(1).Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "CH_REN.xls")
    wb1.Activate
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("GLO-REN").Activate
    Range("A65000").End(xlUp).Offset(1).Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "LO_INT.xls")
    wb1.Activate
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("INT").Activate
    Range("A65000").End(xlUp).Offset(1).Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "LO_PRE.xls")
    wb1.Activate
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("PRE").Activate
    Range("A65000").End(xlUp).Offset(1).Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
Set wb1 = Workbooks.Open(repertoire & "LO_REN.xls")
    wb1.Activate
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Worksheets("GLO-REN").Activate
    Range("A65000").End(xlUp).Offset(1).Select
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
 
End Sub

Sans boucle :

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
Public wb As Workbook
Public repertoire As String
 
Sub test()
    repertoire = "D:\Test\Donnees\"
    Set wb = ThisWorkbook
    wb.Worksheets("INT").UsedRange.Clear
    wb.Worksheets("PRE").UsedRange.Clear
    wb.Worksheets("GLO-REN").UsedRange.Clear
 
    Call Routine("AL")
    Call Routine("CH")
    Call Routine("LO")
End Sub
 
Sub Routine(Suff As String)
    Call Routine2(Suff & "_INT.xls", "INT")
    Call Routine2(Suff & "_PRE.xls", "PRE")
    Call Routine2(Suff & "_REN.xls", "GLO-REN")
End Sub
 
Sub Routine2(Fichier As String, Stock As String)
    Dim wb1 As Workbook
    Set wb1 = Workbooks.Open(repertoire & Fichier)
    Range("A1").CurrentRegion.Copy
    wb.Worksheets(Stock).Range("A" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    wb1.Close False
End Sub

Je n'ai pas testé, il se peut donc que tu ais un peu de débugage à faire.

29/07/2016, 10h59
Lyricslife

Menhir, ce code marche parfaitement !
Tout cela me servira dans de nombreux projets !

Merci à tous pour votre grande aide :)