Help Macro concatenation pour selection d'une plage

[Stephane Da Silva]

Bonjour,

Pour mon travail je dois réaliser un travail de concatenation et amateur de macros j'en utilise assez souvent. Le but est de réaliser une étude et pour cela je dois concatener plusieurs fichiers. j'ai alors trouvé une macro très bien écrit et qui correspond à mes attentes ! Le seul petit couac est que je ne comprends pas 3 lignes de cette macro qui sont les plus importantes afin de la personnaliser... C'est pour cela que je viens à vous (pour la première fois après toutes les infos utiles que j'ai pu récupérer sur ce forum !) afin de vous demander votre aide :
Je n'arrive pas à selectionner une plage de cellules sur les fichiers sources seulement cellule par cellule via le Offset(0,1) (0,2)(0,3).... mais je dispose de 3000 cellules sur les fichiers sources... je voudrais selctionner une palge de type ("B2:AD500") mais impossible je n'y arrive pas et pourtant j'y ai passé du temps et j'ai cherché partout.. Pouvez-vous m'aider afin de réaliser ce travail qui m'apporterai beaucoup Merci beaucoup

voici la macro : http://www.gcexcel.com/vba-recuperer-les-donnees-de-plusieurs-fichiers/

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("Concatenation") 'On copie les données de la feuille 1
DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 1 'ligne pour écrire le log des fichiers compilés

' - On copie les données vers le fichier Recapitulatif; à adapter
Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
rgRecap = Time
With wsSource
rgRecap.Offset(0, 1) = .Range("B20")

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

 

[gosselien]

Bonjour,
sans fichier..
la dernière ligne et la dernière colonne:

Lastrow = Cells.Find("*", [a1], SearchDirection:=xlPrevious).Row
Lastcol = Cells.Find("*", [a1], SearchDirection:=xlPrevious).Column

P.

 

[Stephane Da Silva]

Bonjour gosselien,

Merci pour votre réponse rapide et du temps que vous accordez à ma demande !

Désolé pour le fichier c'est la première fois que je rédige une message sur le forum je ne sais pas trop comment m'y prendre !
voici le fichier récapitulatif : Test2.Xlsm (ci-joint) avec la macro contanation (Bouton 1)
et 2 exemples de fichiers sources : (le tableau dans la feuille concatenation à copier )

Je ne vois pas trop où utiliser votre ligne de code :/ Je viens de la palcer au niveau de RgRecap.Offset(0.1) =

Mais cela ne fonctionne pas !

Est-ce qu'avec les fichiers ma requête est plus claire ?

 

[gosselien]

re,

Une tentative ici

P.

 

[Stephane Da Silva]

Re,

Je viens d'essayer ta macro mais cela ne fonctionne pas :/

En revanche je viens de trouver une solution !! alleluyah

Merci pour ton aide je vais cloturer le sujet !

Ps : Voici le code pour ceux qui voudraient une macro concatenation avec une grande plage de cellule à copier sur les fichiers sources :


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("concatenation") 'On copie les données de la feuille 1
DernLign = wbRecap.Sheets(1).Range("B60000").End(xlUp) 'ligne pour écrire le log des fichiers compilés

' - On copie les données vers le fichier Recapitulatif; à adapter


Set rgRecap = wsRecap.Range("B65000").End(xlUp).Offset(1, 0)
With wsSource
rgRecap.Offset(1, 0).Resize(403, 7).Value = .Range("B2:H404").Value



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