Autres Regroupement de feuilles

[chilo27]

Bonjour le forum
Je souhaite regrouper les feuilles 135 136 137 etc dans une autre feuille
appelée regroupement

Sans la prise en compte des autres feuilles
Je précise que j'ai effectué des recherches, on en trouve mais malheureusement pas on le souhaite

En Vba si possible

En vous remerciant par avance

 

[Bernard_XLD]

Bonjour Chilo27, le forum

une seule ligne à importer à chaque fois ?
à partir de la ligne 6 dans regroupement ?

Cordialement

 

[chilo27]

Bonjour le forum, Yeahou

Merci de la réponse

A partir de la ligne 6
Pour les lignes il peut y avoir plusieurs, je n'ai pas voulu alourdir

Merci pour l'aide

 

[Bernard_XLD]

tu veux juste les valeurs ou aussi les formats ?

 

[Bernard_XLD]

on écrase les valeurs existantes ou à la suite ?

 

[Bernard_XLD]

il y a toujours des valeurs en colonne A pour tes lignes de feuille ?

 

[Bernard_XLD]

un premier jet copie des valeurs, sans écrasement des données et en partant du principe que la dernière ligne d'une feuille a toujours une valeur en colonne A !

Sub Regroupement_Données()
    Dim Address_Feuilles As String
    If Sheets("REGROUPEMENT").Range("A6").Value = "" Then
        With Sheets("135")
            If Not .Range("A2").Value = "" Then
                Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                Sheets("REGROUPEMENT").Range("A5").Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
            End If
        End With
    Else
        With Sheets("135")
            If Not .Range("A2").Value = "" Then
                Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                Sheets("REGROUPEMENT").Range("A65536").End(xlUp).Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
            End If
        End With
    End If
    If Sheets("REGROUPEMENT").Range("A6").Value = "" Then
        With Sheets("136")
            If Not .Range("A2").Value = "" Then
                Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                Sheets("REGROUPEMENT").Range("A5").Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
            End If
        End With
    Else
        With Sheets("136")
            If Not .Range("A2").Value = "" Then
                Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                Sheets("REGROUPEMENT").Range("A65536").End(xlUp).Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
            End If
        End With
    End If
    If Sheets("REGROUPEMENT").Range("A6").Value = "" Then
        With Sheets("137")
            If Not .Range("A2").Value = "" Then
                Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                Sheets("REGROUPEMENT").Range("A5").Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
            End If
        End With
    Else
        With Sheets("137")
            If Not .Range("A2").Value = "" Then
                Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                Sheets("REGROUPEMENT").Range("A65536").End(xlUp).Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
            End If
        End With
    End If
    
End Sub

 

[chilo27]

Rebonjour le Forum, Yeahou

Cela Fonctionne après une personnalisation
Cela Comme j'aurai plusieurs de l'ordre d'une trentaine de feuilles
n'est il pas possible de regrouper les feuilles sans avoir à les énumérer et à condition qu'elles soient différentes, de création, information résumé se sont là des feuilles qui ne vont pas bouger

 

[Bernard_XLD]

facile si elles sont numérotées et que les numéros se suivent ou sinon que les index se suivent
c'est quoi ta personnalisation ?

 

[Bernard_XLD]

voili !

Sub Regroupement_Données()
    Dim Address_Feuilles As String, Compteur As Integer
    For Compteur = 135 To 137
        With Sheets(CStr(Compteur))
            If Sheets("REGROUPEMENT").Range("A6").Value = "" Then
                If Not .Range("A2").Value = "" Then
                    Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                    Sheets("REGROUPEMENT").Range("A5").Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
                End If
            Else
                If Not .Range("A2").Value = "" Then
                    Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
                    Sheets("REGROUPEMENT").Range("A65536").End(xlUp).Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
                End If
            End If
        End With
    Next Compteur
End Sub

 

[Bernard_XLD]

si tes noms de feuille sont formatés sur un nombre de caractères type 001
remplaces le code:

With Sheets(Right("00" & Compteur, 3))

et si tu identifies avec une chaine texte du type "Données001"

With Sheets("Données" & Right("00" & Compteur, 3))

 

[chilo27]

rebonjour le forum, yeahou

Merci pour l'aide

Je vais l'essayer et je reviendrai vous donner mon avis

Merci beaucoup

 

[Bernard_XLD]

Cela Fonctionne après une personnalisation

c'est quoi ta personnalisation ?

tu ne m'as pas répondu, c'est quoi ta personnalisation ?

 

[chilo27]

ME voila de retour


Sub Regroupement_Données01()

Dim Address_Feuilles As String, Compteur As Long
For Compteur = 135 To 141 ---- j'ai ajouté des feuilles qui ne sont pas prises en compte


With Sheets(CStr(Compteur))-------------J'Obtiens le message n'appartient à la sélection
If Sheets("REGROUPEMENT").Range("A6").Value = "" Then
If Not .Range("A2").Value = "" Then
Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
Sheets("REGROUPEMENT").Range("A5").Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
End If
Else
If Not .Range("A2").Value = "" Then
Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
Sheets("REGROUPEMENT").Range("A65536").End(xlUp).Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
End If
End If
End With
Next Compteur
End Sub

autrement cela fonctionne avec les feuilles 135 à 137

Merci pour l'aide

 

[Bernard_XLD]

ME voila de retour


Sub Regroupement_Données01()

Dim Address_Feuilles As String, Compteur As Long
For Compteur = 135 To 141 ---- j'ai ajouté des feuilles qui ne sont pas prises en compte


With Sheets(CStr(Compteur))-------------J'Obtiens le message n'appartient à la sélection
If Sheets("REGROUPEMENT").Range("A6").Value = "" Then
If Not .Range("A2").Value = "" Then
Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
Sheets("REGROUPEMENT").Range("A5").Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
End If
Else
If Not .Range("A2").Value = "" Then
Address_Feuilles = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Address
Sheets("REGROUPEMENT").Range("A65536").End(xlUp).Range(Address_Feuilles).Value = .Range("A2:J" & .Range("A65536").End(xlUp).Row).Value
End If
End If
End With
Next Compteur
End Sub

autrement cela fonctionne avec les feuilles 135 à 137

Merci pour l'aide

cela veut dire que tes noms de feuilles ajoutées ne correspondent pas à 138, 139, 140, 141, que tu as laissé un espace dans le nom ou qu'il en manque 1