copier données plusieurs onglets

[ccpapy]

bonsoir le forum
je cherche à rassembler des données provenant de plusieurs onglets
sur un onglet recap en les mettant à la suite les unes aux autres
et en ajoutant le nom de provenance sur chaque ligne

comme d'habitude un fichier en exemple est plus facile pour comprendre

en vous remerciant par avance

 

[BigDaddy154]

Re : copier données plusieurs onglets

Bonsoir,

un essai à tester.

Cordialement.

 

[gosselien]

Re : copier données plusieurs onglets

Bonsoir,

une manière ici

P.

 

[CISCO]

Re : copier données plusieurs onglets

Bonsoir à tous, bonsoir BigDaddy154, bonsoir gosselien

Une possibilité avec des formules. On peut améliorer tout cela pour supprimer automatiquement les 3 dernières lignes.

@plus

 

[ccpapy]

Re : copier données plusieurs onglets

merci à vous tous pour ces solutions

@BigDaddy54
je ne pourrai pas donner de n° de feuille de départ et de fin . des onglets sont ajoutés ou supprimés de temps en temps
de plus les utilisateurs finaux n'ont pas accès à cette information

@CISCO
la solution par formule n'est pas envisageable , il y aurait trop de cellules à copier et jamais le même nombre de fois. problème à l'impression

@gosselien
je pense que je vais partir sur ta base et essayer d'adapter à mon fichier (demain, il se fait tard... )

je posterai pour indiquer l'avancement du projet.

merci et bonne nuit à vous tous

 

[ccpapy]

Re : copier données plusieurs onglets

bonjour,
j'ai donc testé avec le code de gosselien et adapté à mon fichier.
j'arrive au résultat voulu mais avec l'ajout de l'onglet new comme lui.
je n'arrive pas à écrire directement sur mon onglet recap et me passer de new.
donc
si gosselien ou un autre pouvait simplifier son code de manière à écrire sans l'ajout de l'onglet new
ça m'irait bien.
ps: je n'avais pas penser à effacer les données de l'onglet avant la copie de données. merci d'y avoir pensé.

 

[gosselien]

Re : copier données plusieurs onglets

Bonjour,

tu remplaces le code par celui ci:

Option Explicit
Sub Regroop()
  Application.ScreenUpdating = 0
  Dim Sh As Worksheet, Ws1 As Worksheet
  Dim i As Integer, Titre, Desti, Desti2, Col, Lig, Nblign, Shname
  Set Ws1 = Sheets("recap")
  Ws1.Range("A2:J1000").ClearContents
  Feuil1.Select
  For Each Sh In Worksheets
    If Sh.Name <> "Base" And Sh.Name <> "Recap" And Sh.Name <> "Base2" And _
       Sh.Name <> "Matrice" And Sh.Name <> "Accueil" And Sh.Name <> "New" Then
      Set Desti = Sheets("recap").[A65000].End(xlUp)
      If IsEmpty(Sh.[D7]) Then GoTo suivant
      Lig = Sh.[d65000].End(xlUp).Row
      Col = Sh.Range("d7").Resize(, 8)
      Nblign = Lig - 7 + 1  ' nom de la personne copié X fois
      Sh.Range("D7:L" & Lig).Copy Destination:=Desti(2)
      Desti2 = Ws1.[J65000].End(xlUp).Row
      Set Shname = Sh.[A2]: Shname.Copy
      Ws1.Range("j" & Desti2 + 1, "j" & Desti2 + Nblign).PasteSpecial Paste:=xlPasteValues
    End If
suivant:
  Next
  Application.CutCopyMode = False
End Sub

 

[Patrice33740]

Re : copier données plusieurs onglets

Bonjour,

Essaies ce code :

Option Explicit
Sub Regroop()
Const strWsh As String = "Accueil/Base/Recap/Base2/Matrice/New"
Dim wshOrg As Worksheet, wshDst As Worksheet
Dim rngOrg As Range, celDst As Range
  Set wshDst = Worksheets("Recap")
  wshDst.UsedRange.Offset(1).Clear
  Set celDst = wshDst.Range("A2")
  For Each wshOrg In Worksheets
    If InStr(1, strWsh, wshOrg.Name) = 0 And Not IsEmpty(wshOrg.Range("D7")) Then
      Set rngOrg = Intersect(wshOrg.UsedRange, wshOrg.UsedRange.Offset(6), wshOrg.Columns("D:L"))
      If Not rngOrg Is Nothing Then
        With rngOrg
          .Copy celDst
          celDst.Offset(0, .Columns.Count).Resize(.Rows.Count, 1).Value = wshOrg.Range("A2").Value
          Set celDst = celDst.Offset(.Rows.Count)
        End With
      End If
    End If
  Next wshOrg
End Sub

 

[ccpapy]

Re : copier données plusieurs onglets

re,
merci à vous 2
je vais essayer d'adapter ça.

 

[CISCO]

Re : copier données plusieurs onglets

Bonsoir

merci à vous tous pour ces solutions
...
@CISCO
la solution par formule n'est pas envisageable , il y aurait trop de cellules à copier et jamais le même nombre de fois. problème à l'impression.
...
merci et bonne nuit à vous tous

Il suffit :
* de définir le nom Nomsfeuilles =STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000") dans le gestionnaire de noms,
* d'écrire = SI(LIGNES($1:1)<=NBVAL(Nomsfeuilles);INDEX(Nomsfeuilles;LIGNES($1:1));"") en L1 (Méthode donnée par J Boisgontier sur son site),
* de tirer cette formule vers le bas,
* d'écrire le premier prénom en J2,
* d'écrire =SI(NB.SI(J$2:J2;J2)<NBVAL(INDIRECT(J2&"!D: D"))-6;J2;INDEX(L$1:L$11;EQUIV(J2;L$1:L$11;0)+1)) en J3,
* de tirer cette formule vers le bas aussi longtemps que désiré dans la colonne J,
* d'écrire =DECALER(INDIRECT($J2&"!D6");NB.SI($J$2:$J2;$J2);COLONNES($A:A)-1) en A2,
* de tirer cette formule vers la droite et vers le bas aussi longtemps que désiré.
Tout se fait alors automatiquement, quel que soit le nombre de ligne utile dans les différents onglets.
Trop dur !

@ plus

 

[Patrice33740]

Re : copier données plusieurs onglets

Bonjour CISCO,

Il suffit :
* de définir le nom Nomsfeuilles =STXT(LIRE.CLASSEUR(1);TROUVE("]";LIRE.CLASSEUR(1))+1;99)&INDIRECT("iv65000") dans le gestionnaire de noms,
* d'écrire= Nomsfeuilles en L1,
* de tirer cette formule vers le bas,
* d'écrire le premier prénom en J2,
* d'écrire =SI(NB.SI(J$2:J2;J2)<NBVAL(INDIRECT(J2&"!D: D"))-6;J2;INDEX(L$1:L$11;EQUIV(J2;L$1:L$11;0)+1)) en J3,
* de tirer cette formule vers le bas aussi longtemps que désiré dans la colonne J,
* d'écrire =DECALER(INDIRECT($J2&"!D6");NB.SI($J$2:$J2;$J2);C OLONNES($A:A)-1) en A2,
* de tirer cette formule vers la droite et vers le bas aussi longtemps que désiré.
Tout se fait alors automatiquement, quel que soit le nombre de ligne utile dans les différents onglets.
Trop dur !

Ça ne fonctionne pas,
* d'écrire = Nomsfeuilles en L1,
* de tirer cette formule vers le bas,
donne le nom de la première feuille sur chaque ligne.

J'ai donc essayé comme Jacques à dit :
* d'écrire =SI(LIGNES($1:1)<=NBVAL(nomsfeuilles);INDEX(nomsfeuilles;LIGNES($1:1));"") en L1
et j'obtiens la liste des onglets en colonne L.
J'ai donc déplacé les feuilles Matrice et Accueil avant Pascal pour qu'elles ne gênent pas.

Mais la formule en A2 n'extrait qu'une ligne par feuille au lieu d'un nombre de lignes variable dans chaque feuille.

 

[CISCO]

Re : copier données plusieurs onglets

Bonsoir

Excuse Patrice, je me suis trompé dans mon précédent post : En L1, il faut écrire

=SI(LIGNES($1:1)<=NBVAL(Nomsfeuilles);INDEX(Nomsfeuilles;LIGNES($1:1));"")

@ plus

 

[CISCO]

Re : copier données plusieurs onglets

Rebonsoir Patrice

Bonjour CISCO,

Mais la formule en A2 n'extrait qu'une ligne par feuille au lieu d'un nombre de lignes variable dans chaque feuille.

Il faut créer la colonne J avant de faire la plage A2:I15, car en réalité, c'est la colonne J qui impose le nombre de lignes correct.

@ plus

 

[ccpapy]

Re : copier données plusieurs onglets

bonjour à tous,
des nouvelles de mon fichier :
j'ai finalement adapté le code de gosselien.
merci à vous tous.