regrouper des feuilles

[Pol]

Bonjour à tous,

Pourriez-vous m'aider à faire un formulaire + code vba qui me permettent de regrouper des feuilles d'un classeur si la cellule ( coordonnées renseignées dans un formulaire) est égale à un texte ou un nombre renseigné dans le même formulaire ?

Exemple : si E14 = "Bonjour" en Feuil1, Feuil4 et Feuil7 alors regroupement de ces 3 feuilles sur une nouvelle Feuille nommé Regroup1

Merci beaucoup pour votre aide.

Pol

 

[Staple1600]

Re : regrouper des feuilles

Bonjour à tous

Pol
Pourriez-vous nous aider à t'aider en joignant un fichier exemple avec un formulaire - code vba (on se chargera du code) qui permettent de regrouper des feuilles d'un classeur si la cellule ( coordonnées renseignées dans un formulaire) est égale à un texte ou un nombre renseigné dans le même formulaire ?

NB: pour joindre un fichier, se rendre sur ton premier message dans ton fil, cliquer sur Modifier le message puis sur Gérer les pièces jointes.

 

[Pol]

Re : regrouper des feuilles

Voici un fichier exemple avec le formulaire souhaité.

Merci bcp.

 

[Staple1600]

Re : regrouper des feuilles

Bonjour à tous

POL:
Essaies ce code (à mettre dans le code de l'userform , pas dans un module standard)

Const ADRCELL As String = "$E$3"
Private Sub CommandButton1_Click()
Dim ws As Worksheet, ligs&
    For Each ws In Worksheets
        If Not ws.Name Like "Regroup*" Then
            If ws.Range(TextBox1.Text) = TextBox2.Text Then
            ligs = ws.Cells(Rows.Count, 1).End(xlUp).Row
            ws.Range("A1").Resize(ligs, 5).Copy _
            Sheets("Regroup1").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        End If
    Next ws
UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()
TextBox1 = ADRCELL
End Sub

Et dans un module, ce code pour afficher ton userform

Sub loadusf()
UserForm1.Show
End Sub

 

[Pol]

Re : regrouper des feuilles

Merci bcp staple 1600, c'est génial !

un seul problème, je souhaiterais que la nouvelle feuille regroup1 soit générée toute seule ?? et que si regroup1 existe déjà il incrémente regroup2, regroup3...

As-tu une idée ?

Vraiment merci.

 

[Staple1600]

Re : regrouper des feuilles

Re


Essaies avec cette nouvelle version
Dans le code l'userform

Const ADRCELL As String = "$E$3"
Public t
Private Sub CommandButton1_Click()
Dim ws As Worksheet, ligs&
If existef("Regroup" & t) Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Regroup" & t + 1
End If
Set NF = ActiveSheet
    For Each ws In Worksheets
        If Not ws.Name Like "Regroup*" Then
            If ws.Range(TextBox1.Text) = TextBox2.Text Then
            ligs = ws.Cells(Rows.Count, 1).End(xlUp).Row
            ws.Range("A1").Resize(ligs, 5).Copy _
            NF.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        End If
    Next ws
End Sub

Private Sub UserForm_Initialize()
Dim ws As Worksheet
TextBox1 = ADRCELL
For Each ws In Worksheets
If ws.Name Like "Regroup*" Then
t = t + 1
End If
Next ws
UserForm1.Tag = t
End Sub

Dans un module standard

Sub loadusf()
UserForm1.Show
End Sub

Public Function existef(ByVal wsn$) As Boolean
On Error Resume Next
existef = (Sheets(wsn).Name <> "")
On Error GoTo 0
End Function

 

[Pol]

Re : regrouper des feuilles

C'est quasi parfait, juste un petit problème, il semblerait que le regroupement n'intègre pas toutes les données de chaque feuille regroupées, les feuilles regroupées sont partielles ???

Pouvez-vous encore m'aider ?

Un grand merci JM,

 

[Staple1600]

Re : regrouper des feuilles

Re

POL:
J'ai fait mes tests sur ton fichier joint
donc je n'ai pris en considération les colonnes de A à E
Il suffit donc d'adapter cette ligne en conséquence
ws.Range("A1").Resize(ligs, 5).Copy _
NF.Cells(Rows.Count, 1).End(xlUp)(2)

*Ici le 5 redimensionne la plage jusqu'à la colonne E

 

[Pol]

Re : regrouper des feuilles

OK merci bcp,

Bonne soirée.

Pol