Importe données d'un fichier Excel dans un autre fichier Excel

**clemroussi** · 19/10/2020, 17h01

Bonjour,

Mon projet est le suivant

Mise en contexte: Je suis chargé de réalisé un fichier excel permettant de récupérer les données d'un autre fichier excel, les collés et faire plusieurs page de calcul via ces données.

Problématique: J'aimerais faciliter l'importation de cette liste d'outillage par un bouton "sélectionner" qui ouvre une fenêtre permettant de sélectionner le fichier afin d'avoir son chemin, j'ai suivi qui permettait de le faire avec un fichier .txt ou .csv, j'aimerais maintenant l'adapter à un fichier .xlsx et ensuite, une fois selectionner, grâce à un bouton importer, copier coller ce fichier contenant uniquement une feuille, dans la feuille "Liste outillage" du fichier.

J'espère que la problématique est assez claire.

je vous joins mon fichier ainsi que le code :

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
Dim ligne_debut As Integer:
Dim colonne_debut As Integer:
Dim ligne_fin As Integer:
Dim colonne_fin As Integer:
Dim ligne_enCours As Integer:
Dim colonne_enCours As Integer:
 
Private Sub exporter_Click()
Dim nom_fichier As String
 
ligne_debut = 2: 'signifie que l'importation des données se fera en cellule B2
colonne_debut = 2:
ligne_enCours = ligne_debut: colonne_enCours = colonne_debut
 
Cells.Clear
 
For i = 0 To liste_fichiers.ListCount - 1
lecture (liste_fichiers.List(i))
 
Next i
 
traitement
nom_fichier = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt),*.txt")
sortie.Value = nom_fichier
ecriture (nom_fichier)
 
End Sub
 
Private Sub fermer_Click()
 
End Sub
 
Private Sub importer_Click()
Dim fichier_choisi As String
 
fichier_choisi = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Selectionner un fichier CSV")
 
If (LCase(fichier_choisi) <> "faux" And fichier_choisi <> "0") Then
liste_fichiers.AddItem (fichier_choisi)
End If
 
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub
 
Private Sub lecture(fichier As String)
Dim depart As Integer, position As Integer
Dim texte As String, tampon As String
 
Open fichier For Input As #1
 
Do While Not EOF(1)
 
Line Input #1, texte
depart = 1: position = 1
Do While (position <> 0)
 
position = InStr(depart, texte, ";", 1)
If position = 0 Then
tampon = Mid(texte, depart)
Sheets("import").Cells(ligne_enCours, colonne_enCours).Value = tampon
Exit Do
Else
tampon = Mid(texte, depart, position - depart)
End If
 
Sheets("import").Cells(ligne_enCours, colonne_enCours).Value = tampon
depart = position + 1
colonne_enCours = colonne_enCours + 1
Loop
 
colonne_enCours = colonne_debut
ligne_enCours = ligne_enCours + 1
 
Loop
 
Close #1
 
End Sub

Merci de votre aide

**Philippe Tulliez** · 19/10/2020, 17h25

Bonjour,
Je ne sais pas si cela peut vous aider mais j'ai écrit un billet ayant comme sujet l'importation d'une table structurée se trouvant dans un classeur vers une autre table portant le même nom qui se trouve dans le classeur où réside le code VBA

Voir éventuellement ce billet titré VBA pour Excel - Copier une table structurée sur une autre à l’aide de la méthode Copy

**clemroussi** · 19/10/2020, 17h27

Bonsoir,

Merci pour votre aide mais ce n'est pas ce que je recherche,

CDLT,

CR

**Pierre Fauconnier** · 19/10/2020, 17h40

Salut.

A partir de 2010, c'est normalement une tâche pour Power Query, dont la rôle est justement d'agréger les données. Est-il obligatoire de passer par du VBA?

Les tableaux sont-ils identiques quant à leur structure?

**clemroussi** · 20/10/2020, 08h06

Bonjour,

Je ne connais pas Power Querry, je vais m'y pencher.
Absolument pas, leur taille est variable puisque le fichier excel est une extraction de données avec des paramètres qui diffèrent en fonction des communes.

Cdlt,

**Pierre Fauconnier** · 20/10/2020, 09h10

Je parlais de structure, pas de nombre de lignes, mais j'aurais dû être plus précis.

Les tableaux que tu veux consolider ont-ils le même nombre de colonnes, dans le même ordre, avec les mêmes noms? Lors d'une consolidation de tableaux, Power Query reprend toutes les colonnes de tous les tableaux pour son tableau final. Il y a donc peut-être du nettoyage à faire, qui peut probablement être réalisé également en Power Query.

si les fichiers sont épars sur le disque, ce qui semble être le cas vu ta volonté d'aller chercher les fichiers par boite de dialogue, on pourrait peut-être les rassembler dans un dossier commun. Si non, VBA pourrait se révéler plus avantageux.

**clemroussi** · 20/10/2020, 09h52

Bonjour,

Merci pour votre aide. Je viens de réussir en VBA !! Il me reste une dernière chose à gérer qui est selon moi pas facile. Mon code me permet de récupérer les informations de la feuille de calcul numéro 1 de mon document excel. Comment l'adapter pour pouvoir choisir n'importe quel feuille?

Merci d'avance

Mon code est le suivant :

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
 
'déclarer les variable
 
 
'application pour ouvrir les fichier
arr = Application.GetOpenFilename(filefilter:="excel files, *.xls*", Title:="open excel files", MultiSelect:=True)
 
 
 
'effacer le contenu des collonne
sh.Range("A3:BZ5000").ClearContents
 
For I = LBound(arr) To UBound(arr)
 
ligne_collage = sh.Range("A" & Application.Rows.Count).End(xlUp).Row + 2
 
'Affecter une valeur- le classeur source
Set wb = Workbooks.Open(arr(I))
 
'la feuille dans le classeur source
Set dsh = wb.Sheets(1)
 
'nombre de ligne à copier dans le tableau dans la feuille source
nbl_copier = dsh.Range("B" & Application.Rows.Count).End(xlUp).Row - 2
 
 'copier et coller le tableau dans la feuille source
 dsh.Range("A3:A" & nbl_copier + 2).Copy sh.Range("A" & ligne_collage)
 dsh.Range("B3:B" & nbl_copier + 2).Copy sh.Range("B" & ligne_collage)
 dsh.Range("C3:C" & nbl_copier + 2).Copy sh.Range("C" & ligne_collage)
 dsh.Range("D3:D" & nbl_copier + 2).Copy sh.Range("D" & ligne_collage)
 dsh.Range("E3:E" & nbl_copier + 2).Copy sh.Range("E" & ligne_collage)
 dsh.Range("F3:F" & nbl_copier + 2).Copy sh.Range("F" & ligne_collage)
 dsh.Range("G3:G" & nbl_copier + 2).Copy sh.Range("G" & ligne_collage)
 dsh.Range("H3:H" & nbl_copier + 2).Copy sh.Range("H" & ligne_collage)
 dsh.Range("I3:I" & nbl_copier + 2).Copy sh.Range("I" & ligne_collage)
 dsh.Range("J3:J" & nbl_copier + 2).Copy sh.Range("J" & ligne_collage)
 dsh.Range("K3:K" & nbl_copier + 2).Copy sh.Range("K" & ligne_collage)
 dsh.Range("L3:L" & nbl_copier + 2).Copy sh.Range("L" & ligne_collage)
 dsh.Range("M3:M" & nbl_copier + 2).Copy sh.Range("M" & ligne_collage)
 dsh.Range("N3:N" & nbl_copier + 2).Copy sh.Range("N" & ligne_collage)
 dsh.Range("O3:O" & nbl_copier + 2).Copy sh.Range("O" & ligne_collage)
 dsh.Range("P3:P" & nbl_copier + 2).Copy sh.Range("P" & ligne_collage)
 dsh.Range("Q3:Q" & nbl_copier + 2).Copy sh.Range("Q" & ligne_collage)
 dsh.Range("R3:R" & nbl_copier + 2).Copy sh.Range("R" & ligne_collage)
 dsh.Range("S3:S" & nbl_copier + 2).Copy sh.Range("S" & ligne_collage)
 dsh.Range("T3:T" & nbl_copier + 2).Copy sh.Range("T" & ligne_collage)
 dsh.Range("U3:U" & nbl_copier + 2).Copy sh.Range("U" & ligne_collage)
 dsh.Range("V3:V" & nbl_copier + 2).Copy sh.Range("V" & ligne_collage)
 dsh.Range("W3:W" & nbl_copier + 2).Copy sh.Range("W" & ligne_collage)
 dsh.Range("X3:X" & nbl_copier + 2).Copy sh.Range("X" & ligne_collage)
 dsh.Range("Y3:Y" & nbl_copier + 2).Copy sh.Range("Y" & ligne_collage)
 dsh.Range("Z3:Z" & nbl_copier + 2).Copy sh.Range("Z" & ligne_collage)
 
 
 
wb.Close False
 
 Next I
   With Application
                .ScreenUpdating = True
                .Calculation = xlCalculationAutomatic
            End With
 
Fin:
End Sub

**clemroussi** · 20/10/2020, 09h58

Bonjour,

Les tableaux ont effectivement toujours le même nombre de colonnes mais pas le même nombre de lignes,

Les fichiers ne sont malheureusement par ranger dans le même dossier et ne le seront jamais d'où l'outil pour aller les chercher sur le serveur comme vous avez dit,

Merci de votre aide,

**BENNASR** · 20/10/2020, 10h42

Bonjour
je sais pas si ça va t'aider ou non ...mais une tentative
Etant autodidacte et débutant VBA je propose se qui suit
dans votre classeur qui va recevoir les données vous avez deux onglet "Synthèse" et "Résultat"
dans l'onglet "Synthèse" et à partir de A1 vous dressez un tableau structuré de 4 colonnes
A : Adresse du classeur
B : Nom du classeur
C : Nom de l'onglet (ou se trouve les données à importer"
D : liste de choix O ou N (c-a-d à importer les données ou non)
et puis votre code va ouvrir tous les onglets des classeurs ou en colonne 4 il y a un "O" et importer les données et les coller dans l'onglet "Résultat" , ferme le classeur et fait la même chose avec le classeur suivant
si ça te convient voila le code à tester

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
Sub MiseAjourdonnées()
Dim wkB As Workbook
Dim LISTE_IMPORT As ListObject
Dim chemin As String, fichier As String, Onglet As String
Dim w As Worksheet
Dim X As Range
Dim PlageDeRecherche  As Range
Set F1 = Sheets("Synthèse")
Set F2 = Sheets("RESULTAT")
F2.Cells.ClearContents
Set PlageDeRecherche = Sheets("Synthèse").ListObjects("LISTE_IMPORT").ListColumns(4).DataBodyRange
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ligne = 2
 
For Each X In PlageDeRecherche
    If X = "O" Then
        chemin = F1.Cells(X.Row, 1)
        fichier = F1.Cells(X.Row, 2)
        Onglet = F1.Cells(X.Row, 3)
        On Error Resume Next
        Workbooks.Open chemin & fichier
        Set wkB = ActiveWorkbook
        derlig = wkB.Sheets(Onglet).Cells(Rows.Count, 1).End(xlUp).Row
        wkB.Sheets(Onglet).Range("A1:A" & derlig).Copy
        F2.Cells(Ligne, 1).PasteSpecial Paste:=xlPasteValues
        End If
   Ligne = F2.Cells(Rows.Count, 1).End(xlUp).Row + 1
   wkB.Close
Next X
F2.Select
Set wkA = Nothing
Set wkB = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

certain que mon code nécessite des amélioration surtout coté tableau structuré que je ne maîtrise pas
Bonne Continuation

Importe données d'un fichier Excel dans un autre fichier Excel

Macros et VBA Excel

Discussions similaires

Partager

Partager