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
 
Solution
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+

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+
 

Discussions similaires

Réponses
1
Affichages
269
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo