Compiler plusieurs onglets Excel sur un onglet Synthese

Fermé
DSisco Messages postés 3 Date d'inscription jeudi 23 avril 2015 Statut Membre Dernière intervention 27 avril 2015 - 23 avril 2015 à 10:45
DSisco Messages postés 3 Date d'inscription jeudi 23 avril 2015 Statut Membre Dernière intervention 27 avril 2015 - 27 avril 2015 à 08:21
Bonjour à tous,

Je vous écris aujourd'hui car je rencontre un problème avec une macro pour compiler mon fichier Excel que je vous joins ici :

https://www.cjoint.com/?0DxkZRYkHtz

Depuis 2 jours, j'essaie de trouver une macro qui me permettrait de compiler mes 7 onglets dans un onglet "SYNTHESE".

Il est important pour moi de garder ces onglets car chacun de mes sites gère son onglet et me le renvoie. Le copier/coller à chaque mise à jour dans ce fichier excel ne me dérange pas.

En revanche, les directeurs eux consultent uniquement l'onglet SYNTHESE, d'où mon besoin de compiler mes 7 onglets dans celui ci, et de pouvoir faire des mises à jour automatique (où même s'il y a une manip à faire pour la mise à jour, ce n'est pas grave, du moment que l'on a une compilation à la fin).

Ne connaissant rien aux macros ou au langage VBA j'ai tenté de me débrouiller seule à partir de codes trouver sur les forums, mais je n'arrive jamais à compiler plus de 3 onglets, et là je vous avoue, je craque un peu...

Le code est disponible dans les modules du fichier excel joint, si vous le souhaitez, je peux vous le remettre dans un message ici.

Je vous remercie tous par avance pour votre précieuse aide!
A voir également:

2 réponses

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
23 avril 2015 à 17:15
Bonjour,

Corriges la destination, au lieu de "A1" & x écrire "A" & x

Par exemple, corriges la ligne :
    Sheets("Site de VALENCE").Rows("2:" & x).Copy Sheets("SYNTHESE").Range("A1" & y)

par :
    Sheets("Site de VALENCE").Rows("2:" & x).Copy Sheets("SYNTHESE").Range("A" & y)

0
DSisco Messages postés 3 Date d'inscription jeudi 23 avril 2015 Statut Membre Dernière intervention 27 avril 2015
24 avril 2015 à 08:42
Bonjour Patrice,

Merci pour ton conseil. Malheureusement mon problème persiste...
J'ai réussi à compiler les 3 premiers onglets sur mon onglets synthèse, dès que j'ajoute le 4ie, il vient remplacer les résultats du 3ie.

Sub test_conso()
'

Dim x As Long, y As Long

Sheets("SYNTHESE").Cells.ClearContents

x = Worksheets("IRFSS RA").Range("A" & Rows.count).End(xlUp).Row
Sheets("IRFSS RA").Rows("3:" & x).Copy Sheets("SYNTHESE").Range("A4")


x = Worksheets("Site de LYON").Range("A1").End(xlDown).Row
y = Sheets("SYNTHESE").Range("A" & Rows.count).End(xlUp).Row + 1
Sheets("Site de LYON").Rows("3:" & x).Copy Sheets("SYNTHESE").Range("A" & y)

x = Worksheets("Site de ST ETIENNE").Range("A1").End(xlDown).Row
y = Sheets("SYNTHESE").Range("A" & Rows.count).End(xlUp).Row + 1
Sheets("Site de ST ETIENNE").Rows("3:" & x).Copy Sheets("SYNTHESE").Range("A" & y)

x = Worksheets("Site de VALENCE").Range("A1").End(xlDown).Row
y = Sheets("SYNTHESE").Range("A" & Rows.count).End(xlUp).Row + 1
Sheets("Site de VALENCE").Rows("3:" & x).Copy Sheets("SYNTHESE").Range("A" & y)


End Sub


Est ce que tu as une idée de ce que je pourrais corriger pour arriver à tout combiner ?

Merci :)
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
24 avril 2015 à 09:48
Bonjour,

Essaies :
Sub test_conso()
Dim x As Long, y As Long

  Sheets("SYNTHESE").Cells.Clear
        
  Sheets("IRFSS RA").Cells.Copy Sheets("SYNTHESE").Range("A1") 'pour copier aussi les largeurs de colonne
    
  x = Worksheets("Site de LYON").Range("A" & Rows.count).End(xlUp).Row
  y = Sheets("SYNTHESE").Range("A" & Rows.count).End(xlUp).Row + 1
  Sheets("Site de LYON").Rows("2:" & x).Copy Sheets("SYNTHESE").Range("A" & y)

  x = Worksheets("Site de ST ETIENNE").Range("A" & Rows.count).End(xlUp).Row
  y = Sheets("SYNTHESE").Range("A" & Rows.count).End(xlUp).Row + 1
  Sheets("Site de ST ETIENNE").Rows("2:" & x).Copy Sheets("SYNTHESE").Range("A" & y)
    
  x = Worksheets("Site de VALENCE").Range("A" & Rows.count).End(xlUp).Row
  y = Sheets("SYNTHESE").Range("A" & Rows.count).End(xlUp).Row + 1
  Sheets("Site de VALENCE").Rows("2:" & x).Copy Sheets("SYNTHESE").Range("A" & y)
    
End Sub
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 24/04/2015 à 11:00
Après avoir vu les tableaux, la colonne A n'est pas toujours remplie il serait préférable d'utiliser :
Option Explicit
Sub test_conso()
Dim n°L As Long       'n° ligne destination
Dim d°L As Long       'dernière ligne source
Dim wsS As Worksheet  'feuille source
Dim wsD As Worksheet  'feuille destination

  Set wsD = Worksheets("SYNTHESE")
  wsD.Cells.Clear
  For Each wsS In Worksheets
    If wsS.Index <> wsD.Index And wsS.Range("C1").Value = "PROCESSUS" Then
      'pour chaque feuille concernée (sauf SYNTHESE, Param, liste déroulante, ...)
      If wsS.Range("B1").Value <> wsD.Range("B1").Value Then
        'si synthèse est vierge : copier la 1° feuille avec les titres
        wsS.Cells.Copy wsD.Range("A1")
      Else
        'sinon : ajouter les données
        n°L = wsD.Range("B" & Rows.count).End(xlUp).Row + 1
        d°L = wsS.Range("B" & Rows.count).End(xlUp).Row
        wsS.Rows("2:" & d°L).Copy wsD.Range("A" & n°L)
      End If
    End If
  Next wsS
  
End Sub
0
DSisco Messages postés 3 Date d'inscription jeudi 23 avril 2015 Statut Membre Dernière intervention 27 avril 2015 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
27 avril 2015 à 08:21
Oh oui super!!! Cela à l'air de bien fonctionner (même si j'ai l'impression qu'une ou deux lignes sont encore supprimées au moment de la compilation!).

Je vais voir pour mieux compléter toutes les colonnes de mon tableau voir comme la macro se comporte, je ferais des tests aussi quand je rajoute des lignes, voir comment tout cela se met à jour. Je te ferais un retour.

En tout cas mille merci pour ton aide!
0