Combiner plusieurs feuilles

lbahjaoui

XLDnaute Nouveau
bonjour
j'ai une liste de feuille (environ 40) qui ont le même format et je veux les combiner dans une seul feuille GLOBALE de telle sorte que les lignes des feuilles viennent les une après les autres.

Merci
 

zebanx

XLDnaute Accro
Bonjour Ibahjaoui

Un code simple.

VB:
Sub Recap()
    ' insére dans un même tableau sur la Wks RECAP toutes les données des autres onglets
    Dim dlgR, dlgi As Double
    Dim i As Byte
    Dim SH1 As Integer
    SH1 = 1
    
    Application.ScreenUpdating = False
    Sheets(SH1).Select
    Rows("2:65536").Delete Shift:=xlUp
    On Error GoTo Fin
    For i = 1 To Worksheets.Count
        If UCase(Sheets(i).Name) <> Sheets(SH1).Name Then
            dlgR = Sheets(SH1).Range("a" & Rows.Count).End(xlUp).Row
            With Sheets(i)
                dlgi = .Range("a" & Rows.Count).End(xlUp).Row
                '.Range("a2:m" & dlgi).Copy Sheets(SH1).Range("a" & dlgR + 1)
                .Rows("2:" & dlgi).Copy Sheets(SH1).Range("a" & dlgR + 1)
            End With
        End If
    Next
Fin:
  
End Sub
@+
 

Pièces jointes

  • recap.xlsm
    20.2 KB · Affichages: 28

Staple1600

XLDnaute Barbatruc
Bonjour

Une variante
(à utiliser que si on ne souhaite que compiler les valeurs mais pas les formats)
Pré-requis: Une feuille RECAP doit déjà exister dans le classeur (et correspondre à Sheets(1) )
Toutes les autres feuilles ont la même structure que la feuille 2
(même entête et même nombre de colonnes utilisées)
Normalement avec un grand volume de données, c'est plus rapide ainsi que de passer par un copier/coller classique.
PHP:
Sub Compiler_Feuilles_en_Une()
Dim wrk As Workbook, ws As Worksheet, R_Ws As Worksheet, rng As Range, NbCol&
Set wrk = ActiveWorkbook
Application.ScreenUpdating = False
Set R_Ws = wrk.Worksheets("RECAP"): Set ws = wrk.Worksheets(2) 'à adapter selon configuration du classeur
R_Ws.UsedRange.Clear
NbCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
'récupération de la ligne d'entête sur la feuille 2
R_Ws.Rows(1).Value = ws.Rows(1).Value
'boucle sur toutes les feuilles
For Each ws In wrk.Worksheets
        If ws.Name <> "RECAP" Then
        Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(Rows.Count, 1).End(xlUp).Resize(, NbCol))
         'compilation des données sans passer par le copier/coller
        R_Ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        End If
    Next ws
    R_Ws.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Réponses
8
Affichages
382
Réponses
13
Affichages
474

Statistiques des forums

Discussions
311 720
Messages
2 081 898
Membres
101 834
dernier inscrit
Jeremy06510