Je souhaite faire une macro qui concatène les données de différents fichiers mais sans succès... Quelqu'un aurait il une idée ? J'ai trouvé cette macro sur internet que j'ai legèrement modifié.
Je n'arrive pas a faire en sorte que la macro ci dessous copie des plages entières et non une ligne par une ligne...
En vous remerciant,
Rémi
Sub Creer_Recapitulatif()
Dim wbRecap As Workbook 'fichier recap
Dim wsRecap As Worksheet 'feuille où on écrit les données
Dim wbSource As Workbook 'fichier à ouvrir
Dim wsSource As Worksheet 'feuille où on cherche les données
Dim DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim i As Integer, k As Integer
Dim rgRecap As Range 'plage où on copie les données
Set wbRecap = ThisWorkbook 'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets(1) 'on écrit dans la feuille 1 du fichier récapitulatif
' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next
Application.ScreenUpdating = False
' --- Boucle à travers les fichiers
For k = 1 To UBound(vFichiers)
Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' C'est ici qu'on écrit les instructions
Set wbSource = Workbooks.Open(vFichiers(k)) 'on ouvre le fichier
Set wsSource = wbSource.Sheets(1) 'On copie les données de la feuille 1
' - On copie les données vers le fichier Recapitulatif
Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0) 'Offset : pour décaler
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function
Je voulais copier les données de différents fichiers et les assembler dans une seul fichier.
J'ai trouvé la solution, j'ai fait cela, ca fonctionne plutot bien :
Apres je ne crois pas que cette solution fonctionne sur les lecteurs réseaux... j'essaierai au travail.
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function
Sub ConcaténerDonnées()
Dim SummarySheet As Worksheet
Dim NbLignes As Long
Dim WorkBk As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim vFichiers As Variant
' Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
' Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next
Application.ScreenUpdating = False
' Créer un nouveau classeur
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' NbLignes est la variable qui indique à quelle ligne nous commencons à copier (destination) et sera utile pour la suite comme variable tampon.
NbLignes = 1
' Boucle qui va ouvrir les fichiers un par un
For k = 1 To UBound(vFichiers)
Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
' Ouvrir le classeur à partir duquel nous allons prendre les données
Set WorkBk = Workbooks.Open(vFichiers(k))
'Utile car on ne sait pas combien de ligne nous avons à copier ; dans la dernière ligne indiquer quelles colonnes il doit copier
Dim LastRow As Long
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
Set sourceRange = WorkBk.Worksheets(1).Range("A1:AC" & LastRow)
' Définis ou la plage commence (destination) + redéfinition taille cellules du fichier source
Set destrange = SummarySheet.Range("A" & NbLignes)
Set destrange = destrange.Resize(sourceRange.Rows.Count, _
sourceRange.Columns.Count)
' Copie les valeurs dans le fichier destination
destrange.Value = sourceRange.Value
' Augmente NbLignes du nombre de lignes qui viennent d'etre copiées.
NbLignes = NbLignes + destrange.Rows.Count
' Ferme le classeur sans sauvegarder
WorkBk.Close savechanges:=False
Next k
10 juin 2018 à 16:04
Merci de votre réponse.
Je voulais copier les données de différents fichiers et les assembler dans une seul fichier.
J'ai trouvé la solution, j'ai fait cela, ca fonctionne plutot bien :
Apres je ne crois pas que cette solution fonctionne sur les lecteurs réseaux... j'essaierai au travail.
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function
Sub ConcaténerDonnées()
Dim SummarySheet As Worksheet
Dim NbLignes As Long
Dim WorkBk As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim vFichiers As Variant
' Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
' Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next
Application.ScreenUpdating = False
' Créer un nouveau classeur
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' NbLignes est la variable qui indique à quelle ligne nous commencons à copier (destination) et sera utile pour la suite comme variable tampon.
NbLignes = 1
' Boucle qui va ouvrir les fichiers un par un
For k = 1 To UBound(vFichiers)
Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
' Ouvrir le classeur à partir duquel nous allons prendre les données
Set WorkBk = Workbooks.Open(vFichiers(k))
'Utile car on ne sait pas combien de ligne nous avons à copier ; dans la dernière ligne indiquer quelles colonnes il doit copier
Dim LastRow As Long
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
Set sourceRange = WorkBk.Worksheets(1).Range("A1:AC" & LastRow)
' Définis ou la plage commence (destination) + redéfinition taille cellules du fichier source
Set destrange = SummarySheet.Range("A" & NbLignes)
Set destrange = destrange.Resize(sourceRange.Rows.Count, _
sourceRange.Columns.Count)
' Copie les valeurs dans le fichier destination
destrange.Value = sourceRange.Value
' Augmente NbLignes du nombre de lignes qui viennent d'etre copiées.
NbLignes = NbLignes + destrange.Rows.Count
' Ferme le classeur sans sauvegarder
WorkBk.Close savechanges:=False
Next k
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Cordialement,
Rémi