Bonjour à tous.
Je dois importer dans données d'un classeur à un autre.
Sur mon classeur où toutes les données vont finir, j'ai un onglet recherche dont une colonne est rempli avec le lien des fichiers où je vais chercher les informations.
Mon problème est sur la suite, j'ai testé deux méthodes mais je n'ai pas réussi à copier les données (avec la mise forme) comme je le souhaite.
Je vous met le code de mes deux tentatives :
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 Private Sub ImportButton_Click() 'Déclaration des variables Dim i As Integer Dim n As Integer, Nbf As Integer Dim fichier() As String, nomfichier As String Dim xlApp As New Excel.Application Dim xlBook As New Excel.Workbook Dim xlSheet As New Excel.Worksheet Dim à_importer, cellule_début As Range Dim nl As Integer, l As Integer Cells(3, 8) = Now 'la cellule H3 va prendre la date comme valeur n = Cells(Rows.Count, 2).End(xlUp).Row 'On regarde la dernière ligne écrite pour la liste des fichiers Nbf = n - 5 'On définit le nombre de fichier par le nombre de la dernière ligne écrite moins 5 Label1 = "Importation en cours" 'On informe via le Label que l'importation a commencé ReDim fichier(Nbf) 'On redimensionne le tableau chemin() à la dimension For i = 1 To Nbf 'On boucle sur tout les fichiers fichier(i) = Cells(i + 5, 1) 'On rentre le lien de chaque fichier dans le tableau chemin Next For i = 1 To Nbf 'Pour tous les fichiers nomfichier = fichier(i) Set xlBook = xlApp.Workbooks.Open(nomfichier) 'on ouvre le fichier For Each sheet In xlBook.Worksheets 'Pour chaque feuille du classeur Select Case sheet.Name 'Selon le nom de la feuille Case "Fiche signalétique" 'Cas où le nom de la feuille est Fiche signalétique xlBook.Activate 'on active le classeur d'où on veut retirer les informations Worksheets(sheet.Name).Activate 'On active la feuille d'où on veut retiter les informations nl = Cells(Rows.Count, 1).End(xlUp).Row 'On regarle la ligne de la dernière cellule remplie de la colonne A Set à_importer = Range("A2", "B" & nl) 'On selectionne la plage de données qui nous interesse ThisWorkbook.Worksheets(sheet.Name).Activate 'On active ce classeur à la page qui nous interesse l = Cells(Rows.Count, 1).End(xlUp).Row 'On regarle la ligne de la dernière cellule remplie de la colonne A Set cellule_début = Range("A" & (l + 1), "A" & (l + 1)) 'on définit la cellule de départ du "collage" cellule_début.Resize(nl, 2).Cells.Formula = à_importer.Formula 'ajout des donnés de la feuille Case "Avancement" 'Cas où le nom de la feuille est Avancement Case "Jalons" 'Cas où le nom de la feuille est Jalons Case "Risques revues" 'Cas où le nom de la feuille est Risques revues Case "Risques revues ST" 'Cas où le nom de la feuille est Risques Revues ST Case "Actions revues" 'Cas où le nom de la feuille est Actions revues Case "Actions revues ST" 'Cas où le nom de la feuille est Actions revues SR Case "Indicateurs ZNCR" 'Cas où le nom de la feuille est Indicateurs ZNCR End Select Next xlBook.Close (False) 'On ferme le classeur (sans enregistrer les changements) xlApp.Quit Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing Next UserFormImport.Hide 'On ferme l'UserForm End Sub
Pour le deuxième test, j'ai remplacé la partie après le Case "Fiche Signalétique" par :
Je suis à cours d'idée pour y arriver, si quelqu'un a une solution je suis preneur.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13 xlBook.Activate 'on active le classeur d'où on veut retirer les informations Worksheets(sheet.Name).Activate 'On active la feuille d'où on veut retiter les informations nl = Cells(Rows.Count, 1).End(xlUp).Row 'On regarle la ligne de la dernière cellule remplie de la colonne A Range("A4", "B" & nl).Select 'On selectionne la plage de données qui nous interesse Selection.Copy 'On la copie ThisWorkbook.Worksheets(sheet.Name).Activate 'On active ce classeur à la page qui nous interesse l = Cells(Rows.Count, 1).End(xlUp).Row 'On regarle la ligne de la dernière cellule remplie de la colonne A Range("A" & (l + 2), "B" & (l + 2 + nl - 3)).Select 'on selectionne la plage d'arrivée 'On colle en gardant la mise en forme : Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False
J'espère avoir été clair. (Ou que mes commentaires sur le code vous feront comprendre ce que je fais)![]()
Partager