Macro solution + simple ?

Le 04/05/2010 à 10:17

Bonjour à tous !

Jaimerais avoir vos avis sur un problème :

J'ai 3 classeurs : classeur 1, 2, et 3

Dans un classeur 4, je veux recopier le contenue de tous les onglets de ces autres classeurs sur une feuil unique de mon classeur 4.

Le problème est que cette 3 autres classeurs auront un nombres indéfini d'onglets avec des noms différents que je ne connais pas (je ne peux absolument pas avoir d'emprise la dessus), il me faut donc une facon de recopier ce contenu sur ma feuille, et ce quelque soit le nombre d'onglets des classeur (qui eux auront un nom définis ).

Merci pour votre aide !!

James

Le 04/05/2010 à 11:28

Bonjour à tous,

En résumé, tu veux faire une seule grosse base de données regroupant les

onglets de 3 classeurs, c'est bien çà ?

Questions :

1) ces onglets ont-ils la même structure ?

2) cette opération sera-elle répétitive ?

3) l'ensemble fera combien de lignes ? (environ, fourchette)

peux-tu envoyer un onglet type (seulement quelques lignes)

à te relire

Amicalement

Claude

Le 04/05/2010 à 12:03

Bonjour Caude et merci pour la réponse

En résumé, tu veux faire une seule grosse base de données regroupant les

onglets de 3 classeurs, c'est bien çà ?

Oui et le tout sur un onglet unique: cet onglet contiendra le contenu de tous les autres onglet du range A7 au U200

1) ces onglets ont-ils la même structure ? Non, il y a 4 structure types, mais par la suite je les masquerai à l'aide de macro (j'ai déjà la méthode pour faire cela)

2) cette opération sera-elle répétitive ? On part pour une mise a jour des fichiers 1 fois par mois

3) l'ensemble fera combien de lignes ? (environ, fourchette) Beaucoup, je pense atteindre les 10 000 lignes (en copiant 200 ligne par onglet comme indiquer en haut.

peux-tu envoyer un onglet type (seulement quelques lignes). Je ne pense pas que ca soir nécessaire avec toutes les informations que je viens de donner, et les informations sont confidentielles. (rien de spécial dans ce que je veux copier, les cellules ont des format de validation pour la plupart ou du texte, et les cellules fusionnées sont déja gerée par macro).

Merci pour l'interressement,

James

Le 04/05/2010 à 13:12

re,

Autre question,

Sur chaque classeur, il doit y avoir des onglets à ne pas rapatrier,

si c'est le cas, il faudrait les placer en 1er de sorte à récupérer les feuilles à partir de la 3ème (par exemple)

jusqu'à la dernière.(au besoin ajouter des feuilles vierges au début) pour démarrer toujours à la 3ème,

précise ce point

Les 4 classeurs seront-ils dans le même répertoire ?

Claude

3planning-tontonk.xlsx (89.93 Ko)
Le 04/05/2010 à 14:06

Impossible, les onglet seront mélanger au moment de les rapatrier, il n'est pas envisageable de changer lordre des onglets pour chaque fichier, cela représenterait un travail trop gros !

Pour le moment je pense que la meilleure solution est de tous les rapatrier et de les trier apres (facile ceux que je veux garder ont forcement queque chose d'écrit dans la colonne K et pas les autres ...)

j'ai tenté la macro :

Sub mo()

Dim Wb As Workbook

Dim Ws As Worksheet

Dim cell As Range

For Each Wb In Application.Workbooks

For Each Ws In Wb.Worksheets

Range("A7:U200").Copy Windows("synthèse").Sheets("Feuil3").Range("A65536").End(xlUp).Offset(1, 0)

Next Ws

Next Wb

End Sub

Mais ca me met erreur d'execution 438, et impossible de savoir pourquoi...

Je suis preneur de correction ou d'autres solutions !!

Merci CLaude,

James

1v3-2-totonk.xlsm (45.84 Ko)
Le 04/05/2010 à 16:28

re,

un début,

macro à placer dans "synthèse.xls" mais à lancer à partir du fichier à copier

restera à boucler pour les 3 classeurs

Sub MaBase()
Dim Lg%, i%
'Macros par Claude Dubois pour "james404" Excel-Pratique le 04 Mai 10
Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
    With Worksheets(i)
        If Application.CountA(.Range("k:k")) > 1 Then 'feuille à copier
            Lg = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            .Range("A7:U" & Lg).Copy Destination:=Workbooks("synthèse.xls") _
            .Sheets("Feuil3").Range("A65536").End(xlUp)(2)
        End If
    End With
Next i
End Sub

vérifie la destination

Amicalement

Claude

Le 04/05/2010 à 16:42

Ok pour ta macro, mais avec cela, je ne fais pas le tour des classseurs ouverts, en bouclant la boucle et avec un peu d'aide, on arrive à obtenir ca qui fonctionne en prenant en compte les classeurs ouverts ce qui me semblent très pratiques pour la suite :

Dim Wb As Workbook

Dim Ws As Worksheet

Dim cell As Range

For Each Wb In Application.Workbooks

Wb.Activate

For Each Ws In Wb.Worksheets

Ws.Activate

Range("A7:U200").Copy Workbooks("synthèse").Sheets("Feuil3").Range("A35536").End(xlUp).Offset(1, 0)

Next Ws

Next Wb

L e problème est maintenant (comme tu la dis ce matin), que ce que j'obtiens ne me convient pas car trop long et la macro permettant d'enlever les lignes en trop n'est pas au top. je pense donc qu'en choisissant mes feuille a copier, je gagnerai du temps !

Le pb : je ne connais pas le nom des feuiil donc impossible de passer par la . Etant donné que je diffuserai l'outil, je pensais à eventuellement mettre un espion dans mes feuilles concernées, et lorsque celle ci me reviendront espion sera tjrs présent et la macroo fonctionnera! pb comment faire ca?

2micalle-v4.xlsm (106.12 Ko)
Le 04/05/2010 à 16:48

re,

là, je teste déjà la colonne "K" comme tu disais, peut-être à régler

maintenant tu n'as que 3 classeurs et ce une fois par mois, c'est pas le bout du monde

Le 04/05/2010 à 17:59

SI en faite !! parcqu'une fois l'outil lancé, ce ne sera plus moi qui m'occuperai de ca, donc il faut que ce soit le + simple possible

Le 04/05/2010 à 20:17

Bonsoir,

tu peux mettre un bouton sur une feuille du fichier "synthèse"

Sub MaBase()
Dim Lg%, i%, Wbk$, W As Workbook
'Macros par Claude Dubois pour "james404" Excel-Pratique le 04 Mai 10
        Application.ScreenUpdating = False
        Wbk = ActiveWorkbook.Name
    For Each W In Workbooks
        If W.Name <> Wbk Then
            W.Activate
            For i = 1 To Worksheets.Count
                With Worksheets(i)
                    If Application.CountA(.Range("k:k")) > 1 Then 'feuille à copier
                        Lg = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                        .Range("A7:U" & Lg).Copy Destination:=Workbooks(Wbk) _
                        .Sheets("Feuil3").Range("A65536").End(xlUp)(2)
                    End If
                End With
            Next i
        End If
    Next W
        Workbooks(Wbk).Sheets("Feuil3").Activate
End Sub

édit: éviter d'ouvrir d'autres fichiers que ceux concernés

édit2: 23:45

Le code précédent risque d'écraser des lignes si la colonne "A" n'est pas complètement remplie,

prends plutôt cette macro qui en + sépare les feuilles par une ligne jaune avec le nom du fichier et des feuilles

elle ajoute une feuille nommée "bibi"

Sub RécupFeuilles()
Dim Lg%, Lg2%, i%, Wbk$, W As Workbook
'Macros par Claude Dubois pour "james404" Excel-Pratique le 04 Mai 10
        Application.ScreenUpdating = False
        Wbk = ActiveWorkbook.Name
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("bibi").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets.Add after:=Sheets(2)
        ActiveSheet.Name = "bibi"
        Sheets("bibi").Cells(1, 1) = "Récupération Feuilles" 'obligatoire pour la suite
    For Each W In Workbooks
        If W.Name <> Wbk Then
            W.Activate
            For i = 1 To Worksheets.Count
                With Worksheets(i)
                    If Application.CountA(.Range("k:k")) > 1 Then 'feuille à copier
                    '---- pour assurer si la colonne A n'est pas remplie complètement ,
                    '---- + identifie et sépare les feuilles par une ligne jaune ----
                    With Workbooks(Wbk).Sheets("bibi")
                        Lg2 = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
                        .Cells(Lg2, 1) = W.Name & " - " & Worksheets(i).Name
                        .Rows(Lg2).Interior.ColorIndex = 6
                    End With
                    '----
                        Lg = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                        .Range("A7:U" & Lg).Copy Destination:=Workbooks(Wbk) _
                        .Sheets("bibi").Range("A65536").End(xlUp)(2)
                    End If
                End With
            Next i
        End If
    Next W
        Workbooks(Wbk).Sheets("bibi").Activate
End Sub

Amicalement

Claude

Le 05/05/2010 à 09:11

!!!!!!!!!!!!!!!!!!!!!!!!!!!

Bonjour CLaude !!

Je dois avouer que je suis impressionné par ta macro qui fonctionne exactemeent comme je le voulais !!!

Donc dernière tite chose qui serait vraiment plus commode pour les utilisateurs et après je te laisse tranquille :

-- 05 Mai 2010, 09:18 --

COmment faire pour que cette macro se réalise directement sur ma feuille synthèse sans en créé une autre , et commencer la copie a partir de la ligne A45 (car sur cette fiche de synth-èse je devrai avoir deux tableau en haut de la page?!) Merci pour ton aide en tout cas !!!

Jérémy

Le 05/05/2010 à 12:42

Bonjour Jérémy, forum,

Ajoute un bouton sur la feuille "synthèse" de ton fichier

et affecte-lui ce code

Attention cette feuille est purgée à partir de la ligne 45 à chaque appel de la macro.

Sub RécupFeuilles()
Dim Lg%, Lg2%, i%, Wbk$, W As Workbook
'Macros par Claude Dubois pour "james404" Excel-Pratique le 05 Mai 10
        Application.ScreenUpdating = False
        Wbk = ActiveWorkbook.Name
        Sheets("synthèse").Activate
        Cells(45, 1) = "Récupération Feuilles" 'obligatoire pour la suite
        Lg2 = Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
        Range("a46:u" & Lg2).EntireRow.Delete

    For Each W In Workbooks
        If W.Name <> Wbk Then
            W.Activate
            For i = 1 To Worksheets.Count
                With Worksheets(i)
                    If Application.CountA(.Range("k:k")) > 1 Then 'feuille à copier
                    '---- pour assurer si la colonne A n'est pas remplie complètement ,
                    '---- + identifie et sépare les feuilles par une ligne jaune ----
                    With Workbooks(Wbk).Sheets("synthèse")
                        Lg2 = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
                        .Cells(Lg2, 1) = W.Name & " - " & Worksheets(i).Name
                        .Rows(Lg2).Interior.ColorIndex = 6
                    End With
                    '----
                        Lg = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                        .Range("A7:U" & Lg).Copy Destination:=Workbooks(Wbk) _
                        .Sheets("synthèse").Range("A65536").End(xlUp)(2)
                    End If
                End With
            Next i
        End If
    Next W
        Workbooks(Wbk).Sheets("synthèse").Activate
End Sub

Amicalement

Claude

Le 11/05/2010 à 12:49

Bonjour,

Je vois que tu ouvre d'autres postes,

merci de répondre sur la suite à donner à celui-ci

Claude

Le 11/05/2010 à 14:14

Oui dsl ... problème marquer comme résolu grâce à ton aide !!

D'ailleurs, je ne sais pas si tu as regarde mon 2nd problème, mais je pense qu'un raisonnement dans le même type est à aborder faire le tour des feuilles, selectioonner celle qui ont pour titre recap et additionner les somme ds mon onglet synthèse 2 !!

en faite, il me manque uniquement la facon de mettre "de coté" ces feuilles pour les garder pour le calcul, après, une simple addition entre les valeur de la Cellule B3 fera l'affaire , le tout écrit en vba bien sur !

Le 11/05/2010 à 14:31

solde déjà ce poste, c'est ici

a resolu2
Le 11/05/2010 à 16:26

Oups, je ne comprenais pas ton post car j'avais déjà fait cette manip! de toute évidence mal...

Cette fois c'est bon !! Juste pour info Claude les info kque tu me donnes me servent pour mon stage, j'ai beaucoup d'informatique surotut excel a faire, mais comme ce n'est pas mon domaine je ne connais pas tout (même si je m y interresse de + en + vu la demande !)

Dans tous les cas tu m'a fait gagner un temps précieux avec cette macro, donc je t'en remercie encore !!

Bonne journée

Rechercher des sujets similaires à "macro solution simple"