[RESOLU] Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

[The_big]

Bonjour à toutes et tous

Je rame depuis plusieurs jours sur le forum pour trouver une solution qui pourrait correspondre à mon besoin, en vain.
Voici ce que je souhaite faire :
J’ai plusieurs feuilles dans un classeur (A) distant, dont les noms contiennent tous (toto_...) ou (tata_...) etc mais je n’en connais pas à l’avance le nombre, ces feuilles contiennent toutes la même mise en page
Je souhaite par l’intermédiaire d’un nouveau classeur récupérer les données des feuilles (ToTo_)(Tata ne m’intéresse pas ) et coller dans une feuille
Compliquer à expliquer je mets donc un exemple avec dans le classeur récap le résultat de ce que je souhaite
Merci de votre aide

 

[DoubleZero]

Re : Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Bonjour à toutes et à tous,

Bienvenue sur XLD, The_big.

Une suggestion en pièce jointe. Adapter ce qui doit l'être dans le code "Module1".

A bientôt

 

[The_big]

Re : Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Bonjour DoubleZero,

Merci beaucoup pour ta réponse rapide,
ça correspond exactement à ce dont j'ai besoins, parfait
encore merci
@+

 

[job75]

Re : [RESOLU] Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Bonjour The_big, DoubleZero

Une solution avec ExecuteExcel4Macro qui évite d'ouvrir le classeur source :

Sub CopierFeuilles()
Dim maxi%, chemin, fich$, feuil$, ncol%, nlig&, form$, nf%, i&, j%, v
maxi = 10 'nombre maximum de feuilles possible, à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fich = "A.xlsx" 'à adapter
feuil = "Toto_" 'à adapter
ncol = 5 'nombre de colonnes à copier
nlig = Application.CountA([A:A])
ReDim t(1 To nlig, 1 To maxi * ncol)
form = "'" & chemin & "[" & fich & "]" & feuil
For nf = 1 To maxi
  For i = 1 To nlig
    For j = 1 To ncol
      v = ExecuteExcel4Macro(form & nf & "'!R" & i & "C" & j + 2)
      If Not IsError(v) Then
        'conversion éventuelle en dates
        If IsNumeric(v) Then If CDbl(v) >= DateValue("1/1/2010") _
          Then v = CDate(CDbl(v))
        t(i, ncol * (nf - 1) + j) = v
      End If
Next j, i, nf
With [C1].Resize(nlig, UBound(t, 2))
  .Value = t
  .Columns.AutoFit 'ajustement facultatif
End With
End Sub

Il faut 2 conditions :

- on connait le nombre maximum de feuilles que peut contenir le fichier source (on peut le majorer)

- les noms des feuilles ont la même racine et se terminent par un numéro.

Un bémol : ExecuteExcel4macro ne peut pas récupérer les formats.

C'est pourquoi dans l'exemple je convertis certains nombres en dates, mais on peut formater comme on veut en fonction des feuilles et/ou des colonnes.

Fichier joint.

A+

 

[job75]

Re : [RESOLU] Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Re,

Pour gagner du temps on peut utiliser une boucle Do/Loop et en sortir dès qu'une valeur d'erreur est détectée

Sub CopierFeuilles()
Dim chemin, fich$, feuil$, ncol%, nlig&, form$, nf%, t(), i&, j%, v
chemin = ThisWorkbook.Path & "\" 'à adapter
fich = "A.xlsx" 'à adapter
feuil = "Toto_" 'à adapter
ncol = 5 'nombre de colonnes à copier
nlig = Application.CountA([A:A])
form = "'" & chemin & "[" & fich & "]" & feuil
Do
  nf = nf + 1
  ReDim Preserve t(1 To nlig, 1 To nf * ncol)
  For i = 1 To nlig
    For j = 1 To ncol
      v = ExecuteExcel4Macro(form & nf & "'!R" & i & "C" & j + 2)
      If IsError(v) Then Exit Do
      'conversion éventuelle en dates
      If IsNumeric(v) Then If CDbl(v) >= DateValue("1/1/2010") _
        Then v = CDate(CDbl(v))
      t(i, ncol * (nf - 1) + j) = v
  Next j, i
Loop
With [C1].Resize(nlig, UBound(t, 2))
  .Value = t
  .Columns.AutoFit 'ajustement facultatif
End With
End Sub

Plus besoin de fixer le maximum de feuilles.

Fichier (2).

A+

 

[The_big]

Re : [RESOLU] Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Re bonjour à toutes et tous,
Je me suis emballé un peu vite ce matin en criant victoire,
Après adaptation à mes fichiers, les vrais problèmes sont apparus
J’ai omis de vous dire qu’il y avait des cellules vides aléatoirement
ainsi de des lignes vides due à la mise en page de (A)
Je remets un exemple

@ Job75, merci pour ta participation à mon pb,
Je n’arrive pas à faire fonctionner ta propo, la boucle tourne sans arrêt
Et je n’ai aucune données qui se copies (j’ai bien adapté le chemin, nb de feuilles et colonnes…)
Sans résultat

Merci de votre aide
Bien Cordialement

 

[The_big]

Re : Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Merci Job75, pour ton 2éme fichier
je ne l'avais pas vu , j'ai le même problème que pour DoubleZero
les cellules et lignes vide
avez-vous une solution pour m'aider pour mon pb
un grand merci par avance

 

[DoubleZero]

Re : [RESOLU] Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Re-bonjour, bonjour, job75 ,

...J’ai omis de vous dire qu’il y avait des cellules vides aléatoirement ainsi de des lignes vides due à la mise en page de (A)...

Si la "mise en page de (A)" ne peut être modifiée, je dnne ma langue au chat.

A bientôt

 

[job75]

Re : Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Re,

Pourquoi ne pas avoir donné les bons fichiers dès le début ?

Cela dit ce n'est guère plus difficile, voici la macro de ma version (2) adaptée :

Sub CopierFeuilles()
Dim chemin, fich$, feuil$, ncol%, nlig&, form$, nf%, t(), i&, j%, v
chemin = ThisWorkbook.Path & "\" 'à adapter
fich = "A.xlsx" 'à adapter
feuil = "Toto_" 'à adapter
ncol = 5 'nombre de colonnes à copier
nlig = 2 * Application.CountA([B:B]) 'une ligne vide sur 2
form = "'" & chemin & "[" & fich & "]" & feuil
Do
  nf = nf + 1
  ReDim Preserve t(1 To nlig, 1 To nf * ncol)
  For i = 1 To nlig Step 2
    For j = 1 To ncol
      v = ExecuteExcel4Macro(form & nf & "'!R" & i + 2 & "C" & j + 2)
      If IsError(v) Then Exit Do
      If IsNumeric(v) Then
        'conversion éventuelle en dates
        If CDbl(v) >= DateValue("1/1/2010") Then v = CDate(CDbl(v))
        'cellules vides
        If v = 0 Then v = ""
      End If
      t(i, ncol * (nf - 1) + j) = v
  Next j, i
Loop
Application.ScreenUpdating = False
With [E3].Resize(nlig, UBound(t, 2))
  .Resize(, Columns.Count - 4) = "" 'RAZ
  .Resize(, Columns.Count - 4).NumberFormat = "General" 'RAZ
  .Value = t
  .Columns.AutoFit 'ajustement facultatif
End With
End Sub

Comme ExecuteExcel4Macro renvoie zéro pour les cellules vides, je supprime les zéros.

Edit : il est bon de faire une RAZ des cellules en les effaçant et en les mettant au format "Standard".

Fichier (2 bis).

A+

 

[The_big]

Re : Copie de plusieurs feuilles d'un classeur fermé sur une seule feuille

Re,

Merci Job75, au poil, ça fonctionne parfaitement

désolé je n'avais pas les fichiers originaux sous le nez hier soir quant j'ai posté
du coup j'ai oublié la mise en page .
encore merci vous deux Job75 & Double Zéro pour m'avoir consacré du temps
@+