Discussion :

[Grevious88]

bonjour à tous

je viens vers vous tous d'abord car je sais que vous êtes extrêmement productifs et de bons conseils.

alors voila :
j'ai dans un classeur un certain nombre de feuille avec différents nom mais certaines d'entre elle possède une caractéristique commune c'est que leur nom comprend le mot Group
alors moi j'aimerai fusionner toutes les feuilles comportant le mot Group dans leur nom voila voila merci à vous

[cerede2000]

Bonjour à toi,

Fusionner comment ?
Dans ton esprit, tu prends les données de Group1, tu les places dans une feuille Regroupement, puis Group2 tu viens mettre dans la feuille Regroupement les données directement à la suite des données de Group1 ?

[Grevious88]

bonjour merci à toi

quand je dis fusionner j'entend par la créer une nouvelle feuille appelée x par exemple et que toutes les infos de toutes les autre feuilles soient comprises dedans merci bien

[cerede2000]

As tu lut ce que j'ai indiqué ensuite.... ?
Donne un modèle de classeur avec des feuilles Group et les données comment elles sont présentes.

[Grevious88]

excuse moi j'ai pas compris que tu voulais un fichier
alors voila un fichier test ou seulement deux feuilles sont présente et une feuille regroupement qui représente ce que j'aimerai avoir à la fin
sachant que dans le véritable fichier il y a a peut près trente pages

[cerede2000]

Je te propose ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub regoup()
    Dim regroupSheet As Worksheet
    Dim sheet As Worksheet
    Dim dest As Range
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    If SheetExists("Regroupement") Then
        ThisWorkbook.Sheets("Regroupement").Delete
        Set regroupSheet = ThisWorkbook.Sheets.Add(ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1))
        regroupSheet.Name = "Regroupement"
        Set dest = regroupSheet.[A1]
    End If
 
    For Each sheet In ThisWorkbook.Sheets
        If LCase(Right(sheet.Name, 5)) = "group" Then
            sheet.UsedRange.Copy dest
            Set dest = dest.Offset(sheet.UsedRange.Rows.Count)
        End If
    Next
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
End Sub
 
Function SheetExists(shtName As String) As Boolean
    Dim sht As Worksheet
 
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets(shtName)
    On Error GoTo 0
 
    SheetExists = Not sht Is Nothing
 End Function