Menu

Concatener données

Rmi35 - 5 juin 2018 à 19:40 - Dernière réponse :  helloh
- 10 juin 2018 à 16:04
Bonjour,

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

With wsSource
Range("A1:A2").Select
Selection.Copy
rgRecap = Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
rgRecap = Range("A1")
rgRecap.Offset(0, 1) = .Range("B1")
rgRecap.Offset(0, 2) = .Range("C1")
rgRecap.Offset(0, 3) = .Range("D1")
rgRecap.Offset(0, 4) = .Range("D1")



End With

wbSource.Close 'fermer fichier
Set wbSource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Next k

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

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



Afficher la suite 

Votre réponse

2 réponses

danielc0 196 Messages postés mardi 5 juin 2018Date d'inscription 21 septembre 2018 Dernière intervention - 6 juin 2018 à 14:54
0
Merci
Bonjour,

Tu devrais expliquer plus en détail ce que tu veux faire. Que copier ? Où sont les fichiers, où sont les plages, où coller les plages copiées.

Cordialement.

Daniel
Bonjour,


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
Commenter la réponse de danielc0