Regroupement Fichier

[samy30]

Bonjour

J'utilise une macro que vous m'aviez fourni et qui marche a merveille mais j'ai une petite modif a apporter mais je n'y arrive pas.

La macro ouvre les fichiers excel présent dans un dossier et importe la première feuille et les 7 premières colonnes (A1,B1,...G1).

Et moi j'aurais besoin quelle importe A1,B1,...>G1 et en plus S1.

Sub Creer_Recapitulatif()
Dim sRep As String 'Répertoire ou filtre
Dim sFichier As String
Dim wb As Workbook, ws As Worksheet, rg As Range
Dim wbR As Workbook, wsR As Worksheet, rgC As Range
Dim tablo

Set wbR = ThisWorkbook 'fichier récapitulatif
Set wsR = wbR.Sheets("Recap") 'onglet récapitulatif

Application.ScreenUpdating = False
sRep = ChoisirRepertoire & "\"
'Boîte de dialogue pour choisir répertoire
sFichier = Dir(sRep)
Do While sFichier <> ""
If sFichier <> wbR.Name Then
Set wb = Workbooks.Open(sRep & sFichier) 'ouvrir le fichier
Set ws = wb.Sheets(1) 'les données se trouvent dans le 1er onglet
Set rg = ws.Range("A1").CurrentRegion 'sélection des données
tablo = rg 'mettre les données dans un tablo pour copier ensuite

wsR.Range("A65000").End(xlUp).Offset(1, 0).Resize(rg.Rows.Count, 1) = wb.Name 'nom du fichier
wsR.Range("B65000").End(xlUp).Offset(1, 0).Resize(rg.Rows.Count, 7) = tablo 'données
wb.Close savechanges:=True
End If
sFichier = Dir 'trouve le prochain fichier
Loop
Application.ScreenUpdating = True
End Sub
Function ChoisirRepertoire() As String
Dim diaFolder As FileDialog
' Ouvrir la boîte de dialog
On Error Resume Next
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
ChoisirRepertoire = diaFolder.SelectedItems(1)
Set diaFolder = Nothing
End Function

je vous ai joint l'excel avec la macro que vous m'aviez passé.

La je sèche

Merci

 

[fredl]

Re : Regroupement Fichier

Bonjour,
si tu ne veux pas changer le code de la macro, tu peux simplement mettre un caractère dans chacune des entete de colonnes ( vides)allant de H à R
La selection de la plage à copier se fera alors sur la colonne S aussi!

2eme solution moins rapide : changer le code (pas le temps de mon coté pour l'instant...)
Dis moi.

Frédéric

 

[samy30]

Re : Regroupement Fichier

Merci fredl pour ta réponse

Mais j'ai déjà des caractères dans les entêtes de colonnes.

Le fichier d'origine est rempli jusqu'à Y

J'en met un petit exemple.

 

[samy30]

Re : Regroupement Fichier

J'ai trouvé il me suffit de changer le nombre de colonnes a importer et je ferais le tri après.
ça donne ça

Sub Creer_Recapitulatif()
Dim sRep As String 'Répertoire ou filtre
Dim sFichier As String
Dim wb As Workbook, ws As Worksheet, rg As Range
Dim wbR As Workbook, wsR As Worksheet, rgC As Range
Dim tablo

Set wbR = ThisWorkbook 'fichier récapitulatif
Set wsR = wbR.Sheets("Recap") 'onglet récapitulatif

Application.ScreenUpdating = False
sRep = ChoisirRepertoire & "\"
'Boîte de dialogue pour choisir répertoire
sFichier = Dir(sRep)
Do While sFichier <> ""
If sFichier <> wbR.Name Then
Set wb = Workbooks.Open(sRep & sFichier) 'ouvrir le fichier
Set ws = wb.Sheets(1) 'les données se trouvent dans le 1er onglet
Set rg = ws.Range("A1").CurrentRegion 'sélection des données
tablo = rg 'mettre les données dans un tablo pour copier ensuite

wsR.Range("A65000").End(xlUp).Offset(1, 0).Resize(rg.Rows.Count, 1) = wb.Name 'nom du fichier
wsR.Range("B65000").End(xlUp).Offset(1, 0).Resize(rg.Rows.Count, 7) = tablo 'données je mets 19 a la place de 7
wb.Close savechanges:=True
End If
sFichier = Dir 'trouve le prochain fichier
Loop
Application.ScreenUpdating = True
End Sub
Function ChoisirRepertoire() As String
Dim diaFolder As FileDialog
' Ouvrir la boîte de dialog
On Error Resume Next
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
ChoisirRepertoire = diaFolder.SelectedItems(1)
Set diaFolder = Nothing
End Function

Je vais faire avec à moins que vous trouviez mieux

Merci de m'avoir fait réflêchir 🙂

 

[fredl]

Re : Regroupement Fichier

Bien vu!
A+
frédéric

 

[Josh152]

Re : Regroupement Fichier

Petite question: je n'ai pas trouvé comment copier non pas une ligne mais une colonne. Je pense que c'est sur la ligne: "Set rg = ws.Range("A1").CurrentRegion" mais je ne vois pas comment faire.
Merci de vos lumières!!

 

[fredl]

Re : Regroupement Fichier

Set rg = ws.Range(Range("A1"), Range("A1").End(xlDown))

Fred