Passer d'un onglet à l'autre via une variable

Question

Je me permet de venir vers vous car voila j'ai un fichier excel avec divers onglets Par exemple : Récapitulatif Récapitulatif Devis et des onglets de 1 à 100 ( exemple car c'est variable ) Voila j'aimerais sachant que les onglets de 1 à 100 son toujours de la même trame avoir une fonction qui me permet de via une variable de passer d'un onglet à l'autre : J'ai tester : Dim Var2 As Long Var2 = 1 While Var1 &lt;= Nombre Worksheets(Var2).Select Var2 = Var2 + 1 Var1=var1+1 Wend Dim Var2 As Long While Var1 &lt;= Nombre sheets(Var2).Select Var2 = Var2 + 1 Var1=var1+1 Wend Et impossible par contre si je met sheets("1").Select pas de problème j'ai mon onglet 1 qui est sélectionner et si je met Dim Var2 As Long Var2 = 12 While Var1 &lt;= Nombre Worksheets(Var2).Select Var1=var1+1 Wend Sans incrémentation il va me sélectionner mon onglet 5 et pas le 12 Autrement j'ai penser mettre une variable dans une feuille configuration qui s’agrémentera mais voila j'ai pas tester je préfère demander avis d'expert avant de me lancer dans cette recherche Je vous remercie des diverse réponse que vous pourrez m'apporter...

Fred35 · Answer

Je suis peut être fatigué, mais c'est pas très claire... quel est le but de cette macro ? Les sélectionner un à un ? Faire exécuter une macro sur chacun de ces onglets ...

Fred35 · Answer

Pour le coup si vous voulez avoir des réponses mettez un fichier d'exemple avec le résultat souhaité, pas forcément 100 onglets, 2 ou 3 peuvent suffire...

Fred35 · Answer

Re bonjour,

J'ai un début de piste mais j'ai besoin de l'aide d'une âme charitable.

Je bloque sur un truc tout bête, mais si quelqu'un pouvait m'expliquer mon erreur...

Voici ce que j'ai fait :

Sub test()
Dim Derligne, DerLgn, NbFeuilles As Long
Dim Ws As Worksheet

With Columns("A:E")
    .ClearContents
    .MergeCells = False
End With

Set Ws = Sheets("Synthèse")
DerLgn = Ws.Range("A65536").End(xlUp).Row + 1
NbFeuilles = Sheets.Count

For Feuilles = 4 To NbFeuilles
    With Sheets(Feuilles)
    Derligne = .Range("E65536").End(xlUp).Row
        Ws.Cells(DerLgn, 1) = "Onglet " & .Name
        Ws.Range("A" & DerLgn & ":E" & DerLgn).MergeCells = True
        Ws.Range("A" & DerLgn & ":E" & DerLgn).HorizontalAlignment = xlCenter
        .Range("A3" & ":E" & Derligne - 1).Copy
        Ws.Range("A" & DerLgn + 1).Paste
        Application.CutCopyMode = False
    End With
Next Feuilles

Set Ws = Nothing

End Sub

Et j'ai un bug sur la ligne surlignée...

Fred35 · Answer

Re bonjour,

Après une petite sieste et avoir tout repris à 0, j'avais pris le problème à l'envers.

Voici un code à placer dans un module (en espérant qu'il convienne)

Sub test()
Dim DerLgn, DerLigne As Long
Dim Ws As Worksheet

Application.ScreenUpdating = False

With Sheets("Synthèse").Columns("A:E")
    .ClearContents
    .MergeCells = False

    DerLgn = 1

    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Synthèse" And Ws.Name <> "Configuration" And Ws.Name <> "Final" Then
            .Cells(DerLgn, 1) = "Onglet " & Ws.Name
            .Range("A" & DerLgn & ":E" & DerLgn).MergeCells = True
            .Range("A" & DerLgn & ":E" & DerLgn).HorizontalAlignment = xlCenter
            DerLigne = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
            Ws.Range("A3" & ":E" & DerLigne - 1).Copy .Range("A" & DerLgn + 1)
            DerLgn = DerLgn + DerLigne - 2
            Application.CutCopyMode = False
        End If
    Next Ws
End With

Application.ScreenUpdating = True

End Sub