regrouper des feuilles

Pol

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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.
 

Staple1600

XLDnaute Barbatruc
Re : regrouper des feuilles

Bonjour à tous

POL:
Essaies ce code (à mettre dans le code de l'userform , pas dans un module standard)
Code:
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
Code:
Private Sub UserForm_Initialize()
TextBox1 = ADRCELL
End Sub
Et dans un module, ce code pour afficher ton userform
Code:
Sub loadusf()
UserForm1.Show
End Sub
 
Dernière édition:

Pol

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Re : regrouper des feuilles

Re


Essaies avec cette nouvelle version
Dans le code l'userform
Code:
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
Code:
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
Code:
Sub loadusf()
UserForm1.Show
End Sub
Code:
Public Function existef(ByVal wsn$) As Boolean
On Error Resume Next
existef = (Sheets(wsn).Name <> "")
On Error GoTo 0
End Function
 

Pol

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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
 

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 727
Membres
110 552
dernier inscrit
jasson