Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Concatener données issues de différents fichiers

Aucune réponse
Avatar
Remi92
Bonsoir,

Je souhaite concaténer des données venant de plusieurs fichiers avec une forme identique. APrès quelques recherches j'ai trouvé cette macro que j'ai légérement modifié. Cependant, je n'arrive pas à lui faire copier des plages entières de données... Savez-vous d'ou vient m'on problème ?

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


Rémi

Réponses