Résolu XL 2016 regrouper plusieurs onglets dans un nouveau fichier

hesteve

XLDnaute Nouveau
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).

1598001438817.png
 
Ce fil a été résolu! Aller à la solution…

job75

XLDnaute Barbatruc
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 :
VB:
ActiveSheet.UsedRange.Copy xSht1.Range("A" & Rows.Count).End(xlUp).Offset(1)
par :
VB:
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+
 
Ce message a été identifié comme étant une solution!

hesteve

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

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

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas