Concatener plusieurs onglets en un seul

Hello les amis,

J’adore travailler sur excel, mais les Macro ne sont pas mon point fort.

Surtout lorsqu’il s’agit de bidouiller le code.

Merci d’avance à ceux qui vont prendre le temps de me lire et peut-être même de me répondre.

Voici le problème :

J’ai un méga fichier de suivi. Je souhaite regrouper dans l’onglet « TOTAL », toutes les info des autres onglets identiques (plusieurs services de mon travail) contenu dans les cellules B7:G2000

J’ai déjà une macro mais je crois qu’à force de bidouiller, je me suis perdu dans les méandres du code…

Evidemment, je souhaite regrouper les infos à la suite sans les lignes vides. La recherche de la dernière ligne vide peut se faire dans la colonne B. Car si B n’est pas remplie, les autres infos ne servent à rien.

Au passage, la macro doit éviter de copier des infos des 7 premiers onglets.

J’espe Être assez claire dans ma demande

Un grand merci pour tout ce que vous faites ici les gars. Vous êtes des génies d’Excel et vos réponses me servent très souvent dans mes fichiers.

Voici le code actuel :

Sub Macro1()

' déclaration des variables

Dim Fe As Worksheet
Dim Plage As Range

' Supprime les anciennes données et mise en page

Sheets("TOTAL").Select

   Range("A2:F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
   With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A2").Select
    Cells.FormatConditions.Delete

' Copie d 'une page

For Each Fe In ThisWorkbook.Worksheets

    If Fe.Name <> "TOTAL" Then
    If Fe.Name <> "MENU" Then
    If Fe.Name <> "VIERGE" Then
    If Fe.Name <> "Listes" Then
    If Fe.Name <> "BASE NAVALE TOULON" Then
    If Fe.Name <> "GENDARMERIE MARITIME" Then
    If Fe.Name <> "Listes 2" Then
    If Fe.Name <> "Comparatif AID@" Then

    With Fe

    'définie la plage sans la ligne de titres
    Set Plage = Range(Cells(7, 2), Cells(2000, 7))

    End With

    'colle les valeurs dans la feuille "TOTAL"
    'après la dernière ligne non vide
    Plage.Copy Worksheets("TOTAL").Range("A65500").End(xlUp).Offset(1, 0)

End If
End If
End If
End If
End If
End If
End If
End If

Next Fe

End Sub

Bonjour,

Tu ferais mieux de fournir un fichier plutôt que ce code enregistré insipide dont je ne vois quasiment aucune ligne à conserver !

Pour explication : mettre en variable la feuille Total (ce sera utile ultérieurement, supprimer l'existant délimité par UsedRange, avec Clear + une ligne pour les MFC, soit 2 lignes ! Utiliser un SelectCase pour les feuilles à ne pas prendre en considération, les autres étant alors prises en compte, définir la plage à récupérer avec CurrentRegion. Ensuite on ne copie que si l'on veut conserver aussi les mises en forme et autres éléments...

Re,

Sub MacroTotal()
    Dim wsT As Worksheet, Fe As Worksheet, Plg As Range, n&, nn&
    Set wsT = Worksheets("TOTAL")
    With wsT.UsedRange
        .FormatConditions.Delete
        .Offset(1).Clear
    End With
    nn = 2
    For Each Fe In Worksheets
        Select Case Fe.Name
            Case "TOTAL", "MENU", "VIERGE", "Listes", "BASE NAVALE TOULON", _
             "GENDARMERIE MARITIME", "Listes 2", "Comparatif AID@"
            Case Else
                With Fe
                    n = .Range("B" & .Rows.Count).End(xlUp).Row - 6
                    If n > 0 Then
                        Set Plg = .Range("B7").Resize(n, 6)
                        Plg.Copy wsT.Range("A" & nn)
                        nn = nn + n
                    End If
                End With
        End Select
    Next Fe
End Sub

Cordialement.

Merci pour votre rapidité 👍

Je teste le code demain au travail et je vous dit ce qu’il en est.

Dsl pour ma page de code degueulasse 😷😰

Merci c’est exactement ce qu’il me fallait.

Tu gère.

Bonne continuation.