Choix Feuille de travail via macro

Bonjour,

J'ai une macro qui fonctionne comme je le souhaite mais j'aurai voulu pouvoir choisir la feuille où cette macro s’exécute via la macro (Origine" dans la macro). Donc il faudrait je pense une liste déroulante au sein de la macro qui reprenne l'ensemble des onglets.

Et au passage vérifier si la feuille résultat (Feuilledest) existe (si elle existe, création d'une autre feuille (même nom mais avec un chiffre qui s'incrémente à la fin)).

Public Sub Transposer()
    Dim total_lignes As String
    Dim origine As String
    Dim Destination As String
    Destination = "MEF_"
    Dim Feuilledest As String

    total_lignes = InputBox("Lignes Max", "Lignes Max")
    origine = InputBox("Feuille à mettre en forme ?", "Nom de la feuille à mettre en forme")

    If total_lignes & origine <> "" Then
      Dim derLigne%, i%
      Feuilledest = (Destination + origine)
      Sheets.Add.Name = Feuilledest

    Worksheets(origine).Activate
    derLigne = Worksheets(origine).Range("A1").End(xlDown).Row
    For i = 0 To Application.WorksheetFunction.Ceiling(derLigne, 5) / 5 - 1
        Range(Cells(1 + i * total_lignes, 1), Cells(total_lignes + i * total_lignes, 2)).Copy Worksheets(Feuilledest).Cells(1, 1 + i * 3)
    Next i
    Range("A1:B1").Select
    Worksheets(Feuilledest).Activate
    Cells.Select
    Selection.ColumnWidth = 3.71
    Cells.EntireColumn.AutoFit
    Range("A1:B1").Select

    ElseIf total_lignes Or origine = "" Then
          MsgBox ("Veuillez saisir un nombre de ligne et le nom de l'onglet à mettre en forme")
    End If

End Sub

Merci d'avance

Peut-être en utilisant ce type de code ??

Sub Menu()
Application.CommandBars("Workbook tabs").ShowPopup 500, 200
End Sub

Salut le fil

Pour tester l’existence d'une feuille...

' Procedure : SheetExist
' Date      : 15/12/2016
' Auteur    : JeanPaul
' Objectif  : Tester si une feuille existe
' Entrée    :
' Sortie    : True ou False
' Note      :
' Exemple   :  SheetExist(FeuilleDest)     Retour : True OU Fasle
Function SheetExist(stFeuille) As Boolean
    On Error Resume Next
    SheetExist = Not (ThisWorkbook.Sheets(stFeuille) Is Nothing)
End Function

Pour sélectionner ta feuille tu crée une UserForm avec une zone de liste que tu chargeras avec le nom de toutes les feuilles.

Bonne prog.

Bonjour,

Désolé pour lé réponse tardive mais pas de connexion internet ce weekend.

Merci pour les réponses

Pour la sélection de feuille je voulais passer par le Userform mais c'est là que je coince.

Je me permets de remonter, si quelqu'un a une solution, je n'ai pas réussi à faire ce que je voulais exactement.

Merci

Bonjour,

Je n'ai pas regarder le reste du code mais si tu veux un UserForm, voici un exemple. Ton code dans un module standard avec "Origine" et "Total_Lignes" déclarées publiques en tête de module afin que l'UserForm y ait accès :

Public Origine As String
Public Total_Lignes As String

Public Sub Transposer()

    Dim Destination As String
    Dim Feuilledest As String

    Destination = "MEF_"

    UserForm1.Show 'tant que l'UserForm est ouvert, le compilateur n'avance pas dans le code !

    If Origine = "" Then Exit Sub
    If Total_Lignes = "" Then Exit Sub

    If Total_Lignes & Origine <> "" Then
      Dim derLigne%, i%
      Feuilledest = (Destination + Origine)
      Sheets.Add.Name = Feuilledest

    Worksheets(Origine).Activate
    derLigne = Worksheets(Origine).Range("A1").End(xlDown).Row
    For i = 0 To Application.WorksheetFunction.Ceiling(derLigne, 5) / 5 - 1
        Range(Cells(1 + i * Total_Lignes, 1), Cells(Total_Lignes + i * Total_Lignes, 2)).Copy Worksheets(Feuilledest).Cells(1, 1 + i * 3)
    Next i
    Range("A1:B1").Select
    Worksheets(Feuilledest).Activate
    Cells.Select
    Selection.ColumnWidth = 3.71
    Cells.EntireColumn.AutoFit
    Range("A1:B1").Select

    ElseIf Total_Lignes Or Origine = "" Then
          MsgBox ("Veuillez saisir un nombre de ligne et le nom de l'onglet à mettre en forme")
    End If

End Sub

Le code dans l'UserForm où tu auras placé une ListBox, un TextBox et deux boutons (annuler et OK) :

Private Sub UserForm_Initialize()

    Dim Fe As Worksheet

    For Each Fe In Worksheets: ListBox1.AddItem Fe.Name: Next Fe

End Sub

Private Sub CommandButton1_Click()

    'bouton OK
    Origine = ListBox1.Text
    Total_Lignes = TextBox1.Text
    Unload Me

End Sub

Private Sub CommandButton2_Click()

    'bouton Annuler
    Unload Me

End Sub

Bonjour,

Merci de m'aider sur ce point, tout semble être correctement créé pourtant il ne récupère pas les valeurs "origine" et "Total_Lignes" dans le Userform.

En ajoutant un

    
    MsgBox "Nbr de Lignes : " & Total_Lignes & Chr(13) & Chr(10) & "Onglet : " & Origine

Après le UserForm1.Show j'ai effectivement rien

Une idée ?

Voici un classeur test !

Cliques sur le bouton "Lancer la procédure" et tu verras