XL 2016 regrouper plusieurs onglets dans un nouveau fichier

[hesteve]

Bonjour,

Je souhaiterai pouvoir regrouper plusieurs fois le meme onglet "COGNOS TXT FILE" de plusieurs fichiers différents dans un même onglet dans un nouvel Excel.

Le code que j'ai pour l'instant est:

Sub ImportWithReference()
Dim xSht1 As Worksheet
Dim xWb As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim nbfiles As String
Dim nbDT As String
Dim nbNP As String
Dim nbRP As String

On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub

Set xSht1 = Sheets("COGNOS TXT FILE")
If MsgBox("Clear the existing sheets before importing?", vbYesNo) = vbYes Then xSht1.UsedRange.Clear
Application.ScreenUpdating = False


nbfiles = 0

xFile = Dir(xStrPath & "\" & "*.xlsx")
Do While xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht1.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close False
xFile = Dir
nbfiles = nbfiles + 1

Loop
Application.ScreenUpdating = True
MsgBox ("Nombre de fichiers importés " & nbfiles)

Exit Sub
ErrHandler:
MsgBox "no files"

Cependant j'ai un problème, les colonnes contiennent des formules, il me faudrait faire un paste special de value car les formules sont reportées fausses... (a la place de repartir a 1, elles continue a partir de la ligne suivante du nouvel Excel).

 

[job75]

Bonjour hesteve, bienvenue sur XLD,

Cependant j'ai un problème, les colonnes contiennent des formules, il me faudrait faire un paste special de value car les formules sont reportées fausses..

Eh bien pourquoi vous ne le faites pas ? Cela dit perso je préfère une autre méthode, remplacez :

ActiveSheet.UsedRange.Copy xSht1.Range("A" & Rows.Count).End(xlUp).Offset(1)

par :

With xSht1.Range("A" & Rows.Count).End(xlUp)(2)
    ActiveSheet.UsedRange.Copy .Cells 'pour copier les formats
    .Resize(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count) = ActiveSheet.UsedRange.Value
End With

A+

 

[hesteve]

Merci beaucoup pour votre reponse! Je vais essayer tout ca!

Je ne l'ai pas fait car je ne savais pas le faire