XL 2010 regroupement feuilles

[danval]

bonjour,

j'ai un fichier qui possède plusieurs feuilles (noms dans la macro).
je voudrais pouvoir mettre dans une même feuille nommée "GLOBAL PROD" tout ce qui se trouve dans ces feuilles.
les feuilles sont toutes faites de la même façon pour les données donc :
premiére ligne la "2" et colonne de "A" à "R" (ce sont les données à rapatrier de chaque feuille).

le fait d'avoir intégré les noms dans la macro est volontaire car j'ai d'autres feuilles non concernées par la macro.

j'ai déclaré mes variables, fait la sélection de ma feuille par rapport à la liste et calculé le nombre de lignes mais là je suis bloqué pour faire la copie des données.
juste une précision les données sont à copier comme pour les feuilles à partir de la ligne 2 et colonnes B à R
à l'avance merci pour votre aide tjrs aussi précieuse.

Sub global_prod()
Dim dlig As Integer
Dim mesfeuilles
Dim n As Integer
Dim mafeuille As Worksheet

mesfeuilles = Array("ATTENTE PRISE EN MAIN", "ATTENTE CONVOCATION", "EN COURS", "ATTENTE PIECES", "ATTENTE MO", "CONTROLE FINAL", "PRESTATION EXTERNE")
For n = LBound(mesfeuilles) To UBound(mesfeuilles)
   Set mafeuille = Sheets(mesfeuilles(n))
  
   With mafeuille
               dlig = .Cells(Rows.Count, "B").End(xlUp).Row     
  
End Sub

 

[vgendron]

Bonjour,
Peut etre qu'avec un fichier exemple, ca aiderait?
et ta macro.. on est bien d'accord.. n'est pas terminée et ne fonctionne pas..
il te manque des choses dedans.. un truc dans le genre... evidemment. pas testé..

Sub global_prod()
Dim dlig As Integer
Dim mesfeuilles
Dim n As Integer
Dim mafeuille As Worksheet
Dim feuillDest as worksheet

mesfeuilles = Array("ATTENTE PRISE EN MAIN", "ATTENTE CONVOCATION", "EN COURS", "ATTENTE PIECES", "ATTENTE MO", "CONTROLE FINAL", "PRESTATION EXTERNE")
Set feuillDest=sheets("GLOBAL PROD")
dlig =feuillDest .Cells(Rows.Count, "B").End(xlUp).Row
For n = LBound(mesfeuilles) To UBound(mesfeuilles)
   Set mafeuille = Sheets(mesfeuilles(n))
  
   With mafeuille
               .range("A2:R2").copy destination =feuilleDest.range("A" &dlig)     
  end with
dlig =feuillDest .Cells(Rows.Count, "B").End(xlUp).Row
next n
End Sub

 

[danval]

oui la macro n'est pas finie j'ai juste mis ce que je savais faire.
le but est de copier le contenu de chaque feuille (chaque contenu démarre à la ligne 2 et s'étend sur les colonne de B à R)
les contenus bout à bout dans la feuille "GLOBAL PROD" (idem à partir de la ligne 2 et sur les colonnes B à R).
j'ai testé la macro et j'ai une erreur de syntax sur la ligne :
dlig =feuillDest .Cells(Rows.Count, "B").End(xlUp).Row

 

[danval]

il faut donc détecter pour chaque feuille le nombre de ligne à copier et pour la feuille de destination la premiére ligne blanche afin de copier à partir de celle-ci.

 

[vgendron]

donc.. comme tu avais commencé à faire

With mafeuille
         lastline=.range("A" &.rows.count).end(xlup).row
               .range("A2:R" &lastline).copy destination =feuilleDest.range("A" &dlig)     
  end with

 

[danval]

bon je test

 

[danval]

Bonjour,

Bon je me suis creusé la tête pour sortir ce qui suit mais erreur.
et je ne suis pas sure que cela fonctionne:
- il détecte le nombre de ligne de la feuille à copier
- mais je ne sais pas comment faire pour qu'il écrive dans la feuille "GLOBAL PROD" les feuilles les unes en dessous des autres.

merci pour votre aide

Sub global_prod()
Dim dlig As Integer
Dim mesfeuilles
Dim n As Integer
Dim mafeuille As Worksheet
Dim feuillDest As Worksheet

mesfeuilles = Array("ATTENTE PRISE EN MAIN", "ATTENTE CONVOCATION", "EN COURS", "ATTENTE PIECES", "ATTENTE MO", "CONTROLE FINAL", "PRESTATION EXTERNE")
Set feuillDest = Sheets("GLOBAL PROD")
For n = LBound(mesfeuilles) To UBound(mesfeuilles)
   Set mafeuille = Sheets(mesfeuilles(n))
 
   With mafeuille
lastline = .Range("B" & .Rows.Count).End(xlUp).Row
               .Range("B2:T" & lastline).Copy Destination = feuilleDest.Range("B" & dlig)
              
End With
Next n
End Sub

 

[Hasco]

Bonjour,

Essayez:

Sub global_prod()

    Dim mafeuille As Worksheet

    For Each mafeuille In ThisWorkbook.Sheets(Array("ATTENTE PRISE EN MAIN", "ATTENTE CONVOCATION", "EN COURS", "ATTENTE PIECES", "ATTENTE MO", "CONTROLE FINAL", "PRESTATION EXTERNE"))

        mafeuille.Range("B2:T" & mafeuille.Range("B" & Rows.Count).End(xlUp).Row).Copy _
                Destination:=Sheets("GLOBAL PROD").Range("B" & Rows.Count).End(xlUp).Offset(1)
    Next

End Sub

Bonne journée

 

[danval]

Bonjour,

Merci pour ce code.
il fonctionne mais juste une chose il copie aussi l'entête de chaque feuille (ligne 1) alors est-ce possible de ne pas la copier.

Merci

 

[Hasco]

Re

Essayez d'adapter. Nous n'avons toujours pas de classeur exemple. Alors on va tâtonner longtemps!

Bonne journée

 

[danval]

oui je sais mais le classeur est confidentiel alors je ne peux le diffuser.

mais la macro fonctionne juste à corriger le fait qu'elle copie la ligne une alors que sur cette ligne il y as le nom de mes colonnes.

Merci

 

[Hasco]

Re,

Joindre un fichier avec des données bidons reproduisant le problème, c'est trop difficile et fatiguant?
Cette macro n'est pas sensée recopier la ligne 1, c'est donc qu'il se passe quelque chose dans votre fichier.
Je vois d'autres solutions et manières de faire, mais c'est trop fatiguant et difficile.

Bonne journée

 

[danval]

voila.

 

[mapomme]

Bonjour [USER=191962]@danval,

et pour saluer @Roblochon
Essayez une variante pour éviter le phénomène quand les tableaux à copier sont vides (hormis l'en-tête).

Sub global_prod()
Dim mafeuille As Worksheet, xrg As Range
For Each mafeuille In ThisWorkbook.Sheets(Array("ATTENTE PRISE EN MAIN", "ATTENTE CONVOCATION", "EN COURS", "ATTENTE PIECES", "ATTENTE MO", "CONTROLE FINAL", "PRESTATION EXTERNE"))
  Set xrg = mafeuille.Range("B2:T" & mafeuille.Range("B" & Rows.Count).End(xlUp).Row)
  If xrg.Row <> 1 Then xrg.Copy _
      Destination:=Sheets("GLOBAL PROD").Range("B" & Rows.Count).End(xlUp).Offset(1)
Next
End Sub

 

[danval]

super cela fonctionne à merveille un grand merci pour votre aide