Macro consolidation d'onglets

[thenthelo]

Bonjour,

Je reviens sur ce forum pour avoir de l'aide sur ma macro de consolidation d'onglets.
J'ai donc dans mon fichier des onglets de détails que je souhaite consolider dans un onglet de synthèse (appelé "BASE") l'objectif final étant d'avoir une belle base de données pour faire des tableaux croisés dynamiques. Je précise que toutes les colonnes de mes onglets de détails sont identiques d'un onglet à l'autre.
Voici la macro (simplifiée car beaucoup plus de feuilles de détails) :

Sheets("BASE").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("feuille1", "feuille2")
Sheets(s).[A1].CurrentRegion.Offset(1, 0).Copy _
Sheets("BASE").[A65000].End(xlUp).Offset(1, 0)

Problèmes :
- la macro ne me copie mes onglets de détails qu'à partir de leur ligne n° 2 !Pourquoi pas dès la n°1 ??? J'ai contourné le problème en laissant la ligne n°1 à blanc mais bon .... ! Une idée ?
- mes onglets de détails sont peins de calculs, pour simplifier finalement je préférerai que ma macro fasse un copier coller valeur, je pense aussi que ça allégera le fichier. Comment faire ?
- si j'arrive à faire un copier valeur alors je 'aurai plus besoin des 3 premières lignes de mes onglets de détail. Du coup ma macro ne pourrait prendre mes onglets de détail qu'à partir de la ligne n°4. Comment faire ?

Merci d'avance pour votre aide? Attention je n'y connais quasi rien en macro !

 

[fhoest]

Re : Macro consolidation d'onglets

Re,
Staple, désolé mais lorsque je fais le test chez moi la ligne 8 n'est pas écraser,je le fais pourtant plusieurs fois
(rien de grave ma foie,si tel est le cas chez toi il faut juste ajouter +1 a la valeur x=....row+1)
A bientot et merci pour l'explication.

 

[thenthelo]

Re : Macro consolidation d'onglets

Merci beaucoup pour vos réponses

• 
  fhoest il y effectivement un problème dans ta macro : si tu rajoutes des onglets la macro se met à les doubler, les tripler....

• 
  Staple1600 : ta macro fonctionne nickel mais elle est un peu complexe pour moi qui n'y connaît rien ! Du coup je suis embetée pour l'adapter à mes besoins.

Je me pose 2 questions:
- tu choisis tous les onglets autres que "BASE", comment en exclure un second ?
- et enfin cerise sur le gâteau : est il possible aussi de copier le format des cellules de chacun des onglets ?

 

[fhoest]

Re : Macro consolidation d'onglets

re,
En effet j'ai ajouter un onglet et je m'apercoit que le code ne va pas.
Il a l'oeil ce staple,ce n'est pas pour rien qu'il a 9 milles etc.. réponse,
je tire ma révérence.
si son code et au top utilise le ,après tout ce n'est pas un concours,j'essaie juste de t'aider.
je vais tout de meme plancher sur le code pour trouver une solution
Merci à toi et staple A+
la voici:

Sheets("BASE").[A1].CurrentRegion.Offset(0, 0).Clear
  
  For Each s In Array("RF", "RN", "RN1")
      Sheets(s).[A1].CurrentRegion.Copy
      x = Sheets("BASE").Range("A65000").End(xlUp).Row + 1
           If x = 2 Then x = 1
           Sheets("BASE").Range("A" & x).PasteSpecial , Paste:=xlPasteValues
    Next s

Salut et bonne journée.

 

[thenthelo]

Re : Macro consolidation d'onglets

fohest tu es un as.
Avec ton dernier code ça marche parfaitement et j'ai pu y ajouter le copier format.
Bon allez un dernier truc et promis je m'arrête :
Au lieu d'énumérer tous les onglets (j'en ai un paquet) comment faire pour prendre tous les onglets sauf "Feuille1" et "BASE" (bien sur ) ?.

 

[Staple1600]

Re : Macro consolidation d'onglets

Bonjour thenthelo, fhoest, le fil, le forum

Pour honorer mes endives du jour, voici ma version

Sub a()
Dim s As Worksheet, x&
Application.ScreenUpdating = False
    With Sheets("BASE").[A1]
        .CurrentRegion.Clear
            For Each s In ThisWorkbook.Worksheets
            If s.Name <> "BASE" Then
                With s
                .[A1].CurrentRegion.Copy
            Sheets("BASE").[A65000].End(xlUp)(2).PasteSpecial -4163
                End With
            End If
            Next s
        .Rows(1).EntireRow.Delete
    End With
Application.ScreenUpdating = True
End Sub

Je repasserai ici après le boulot pour donner des explications , thenthelo
(bien, qu'avec un petit ALT+F11 puis F1 quand tu es dans Excel, tu devrais comprendre ce code )

 

[fhoest]

Re : Macro consolidation d'onglets

Bonsoir Staple,Thenthelo
c'est a peu près la meme boucle que staple,mais je ne connait pas d'autre methode pour boucler sur des feuilles a part le for i =sheets(2) to sheets.count
sheets(i).[a1].currentregion.copy etc...
donc voici le code :

Sub compil()
'
' test1 Macro
'
Dim s As Worksheet

 Sheets("BASE").[A1].CurrentRegion.Offset(0, 0).Clear
  
  For Each s In ActiveWorkbook.Sheets
  
  'Array("RF", "RN", "RN1")
      If s.Name <> "BASE" Then
      s.[A1].CurrentRegion.Copy
      x = Sheets("BASE").Range("A65000").End(xlUp).Row + 1
           If x = 2 Then x = 1
           Sheets("BASE").Range("A" & x).PasteSpecial , Paste:=xlPasteValues
    End If
    Next s
End Sub

A bientot et A+ a tous.

 

[Staple1600]

Re : Macro consolidation d'onglets

Bonsoir fhoest


Je ne comprends pas le pourquoi de ceci:

If x = 2 Then x = 1

 

[fhoest]

Re : Macro consolidation d'onglets

Bonjour staple,
j'ai mis ce code car sur la ligne du dessous c'est a dire:

Sheets("BASE").Range("A" & x).PasteSpecial , Paste:=xlPasteValues

x=la valeur de la ligne et comme je met:

x = Sheets("BASE").Range("A65000").End(xlUp).Row [COLOR="Red"]+ 1[/COLOR]

pour me situer sur la bonne ligne de la feuille "BASE",je vérifie que pour le premier passage de la macro ma valeur de ligne n'est pas égale à 2 si tel est le cas x=1 donc je colle les valeurs de mon premier onglet a partir de la ligne 1 de la feuille "Base" et non pas de la ligne 2 et ceci uniquement pour le premier passage de la boucle.
(si pas clair fais le test sans cette ligne cela sera plus parlant)
Il y a certainement un autre moyen mais bon je ne suis qu'un amateur en programmation vba et non pas un pro, ce que je connais actuellement et très loin de ce que j'ai appris dans ma scolarité(le dos,le basic(avec N° ligne ,quelques petite fonction de boucle))en fait un bon début certes mais pas le vb comme on le connait aujourd'hui.
J'ai encore tellement de chose a apprendre et c'est pourquoi j'aime avoir des conseils de personne comme toi qui au vu du nombre de tes messages on beaucoup a m'apporter.
Au plaisir..

 

[exene]

Re : Macro consolidation d'onglets

Bonjour,

J'ai hésité à faire remonter la discussion mais je suis dans l'impasse
Dans le fichier joint, j'utilise une macro écrite par Jacques Boisgontier pour consolider dans l'onglet SYNTHESE,les onglets MENAGE et CEDEX. Cela fonctionne très bien mais le fichier réel s'est considérablement alourdi et les calculs deviennent très longs (je suis en mode sur ordre). Je souhaiterais garder dans l'onglet SYNTHESE la mise en forme mais ne copier que les valeurs (et non plus les formules) pour alléger le fichier. J'ai essayé avec l"enregistreur de macro mais je suis incapable d'adapter la macro existante.

Merci pour votre aide.

 

[exene]

Re : Macro consolidation d'onglets

Re

Voici la pièce jointe

 

[Staple1600]

Re : Macro consolidation d'onglets

Bonjour exene

Essayes de cette façon (c'est plus rapide, mais tu perds le format, ce qui a mon sens n'est pas très grave)

Sub Consolide_bis()
Sheets("SYNTHESE").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("MENAGE", "CEDEX")
    If Sheets(s).Name <> "SYNTHESE" Then
    t = Sheets(s).[A1].CurrentRegion.Offset(1, 0)
    Sheets("SYNTHESE").[A65000].End(xlUp)(2).Resize(UBound(t, 1), UBound(t, 2)) = t
    Erase t
End If
Next s
End Sub

Testes sur un fichier volumineux pour voir la différence.

 

[Pierrot93]

Re : Macro consolidation d'onglets

Bonjour exene

Essayes de cette façon (c'est plus rapide, mais tu perds le format, ce qui a mon sens n'est pas très grave)

Sub Consolide_bis()
Sheets("SYNTHESE").[A1].CurrentRegion.Offset(1, 0).Clear
For Each s In Array("MENAGE", "CEDEX")
    If Sheets(s).Name <> "SYNTHESE" Then
    t = Sheets(s).[A1].CurrentRegion.Offset(1, 0)
    Sheets("SYNTHESE").[A65000].End(xlUp)(2).Resize(UBound(t, 1), UBound(t, 2)) = t
    Erase t
End If
Next s
End Sub

Testes sur un fichier volumineux pour voir la différence.

bonjour à tous,

comprends pas trop ce test :

 If Sheets(s).Name <> "SYNTHESE" Then

si "SYNTHESE" n'est pas dans l'array...

bonne journée
@+

 

[exene]

Re : Macro consolidation d'onglets

Bonjour,

Effectivement le calcul est beaucoup plus rapide. Merci pour ton aide . Pour la mise en forme je verrais avec mon boss (il aime bien les tableaux coloriès )

@+

 

[Staple1600]

Re : Macro consolidation d'onglets

Bonjour Pierrot93

Ce sont les joies du Lien supprimé

EDITION: voici une version corrigée (testée et fonctionnelle)
(Mais le format n'est toujours pas récupéré )

Sub Consolide_Vcorrigee()
'//-> Déclarations
Dim sWs As Worksheet, nl&, nc&, dL&, Ld&, t
Set sWs = Sheets("SYNTHESE")

Application.ScreenUpdating = False

sWs.[A1].CurrentRegion.Offset(1, 0).Clear
'//-> consolidation des données
For Each s In Array("MENAGE", "CEDEX")
    dL = Sheets(s).Cells.Find(What:="*", After:=Sheets(s).Cells(1, 1), SearchDirection:=xlPrevious).Row - 1
    t = Sheets(s).Range("A2").Resize(dL, 46)
    nl = UBound(t, 1): nc = UBound(t, 2)
    sWs.[A65536].End(xlUp).Offset(Ld + 1, 0).Resize(nl, nc).Value = t
    Erase t
   Ld = sWs.Cells.Find(What:="*", After:=sWs.Cells(1, 1), SearchDirection:=xlPrevious).Row + 1
Next s
'//-> mise en forme du résultat final
    With sWs
        .Cells(1, 2).Resize(.Cells(65536, "B").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="="
        Set rf = .[_FilterDataBase]
        rf(2).Resize(rf.Rows.Count - 1).SpecialCells(4).Delete Shift:=xlUp
        .AutoFilterMode = False
    End With
  Set sWs = Nothing '//-> Libère la mémoire
Application.ScreenUpdating = False
End Sub