vba:Automatiser la copie des données de 45 feuilles dans une seule

[perdinch]

Bonsoir

Je souhaite copier le contenu de 10 feuilles d'un même classeur dans une seule feuille et cela par MACRO.

La plage de données de chaque feuille à récupérer est la suivante: A1:AZ1000

Le nom de chaque feuille contient le terme "DATA"

Je ne dois copier que les données des feuilles nommée "DATA001" à "DATA010"

AU total j'aurai donC 1000 (lignes)*45(classeurs) soit 10 000 lignes dans une seule feuille.

merci de vos suggestions


perdinch

 

[perdinch]

Re : vba:Automatiser la copie des données de 45 feuilles dans une seule

une coquille s'est glissée il faut lire 10(feuilles) et non 45

perdinch

 

[Robert]

Re : vba:Automatiser la copie des données de 45 feuilles dans une seule

Bonsoir Perdinch, bonsoir le forum,

Je te propose la macro ci-dessous qui copie la plage A1:AZ1000 de tous les onglets commençant par DATA dans un onglet nommé Recap. Tu adapteras ce nom s'il ne te convient pas :

Sub Recap()
Dim og As Worksheet 'déclare la variable og (OnGlet)
Dim pe As Range 'décalre la variable pe (Plage à Effacer)
 
Application.ScreenUpdating = False 'masque les changements à l'écran
 
'*********************************
'suppression des anciennes données
'*********************************
If Sheets("Recap").Range("A2").Value <> "" Then 'condition si la cellule A2 de l'onglet "Recap" n'est pas vide
    Set pe = Sheets("Recap").Range("A2").CurrentRegion 'définit la plage pe
    pe.Clear 'efface la plage pe
End If 'fin de la condition
 
'****************************************************
'récupération des données dans les différents onglets
'****************************************************
For Each og In Sheets 'boucle sur tous les onglets du classeur
    Select Case Left(og.Name, 4) 'action en fonction des 4 premières lettres du nom de l'onglet
        Case "DATA" 'cas "DATA"
            Set dest = Sheets("Recap").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
            og.Range("A1:AZ1000").Copy dest 'copie et colle ;a plage
    End Select 'fin de l'action en fonction de...
Next og 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

 

[perdinch]

Re : vba:Automatiser la copie des données de 45 feuilles dans une seule

merci de votre proposition qui fonctionne parfaitement!

Si je puis me permettre une autre question..

Peux t-on au moment de la copie récupérer le nom de l'onglet sur chacune des lignes de la feuille "Recap"?

MERCI ENCORE

perdinch

 

[Staple1600]

Re : vba:Automatiser la copie des données de 45 feuilles dans une seule

Bonsoir perdinch, Robert


Une autre façon
(qui évite le copier/coller et donc doit s'exécuter plus vite)
Le seul désavantage c'est que l'on a que les données brutes
(pas le format des cellules)

Sub RecopieParArray()
Dim s As Worksheet, p As Range
Application.ScreenUpdating = False
    For Each s In Worksheets
        If Val(Right(s.Name, 3)) <= 10 Then
        Set p = s.Range(s.[A1], s.[AZ1000])
        Sheets("SYNTHESE").[A65536].End(xlUp).Offset(1).Resize(p.Rows.Count, _
        p.Columns.Count).Value = p.Value
        End If
    Set p = Nothing
    Next s
Application.ScreenUpdating = True
End Sub

 

[perdinch]

Re : vba:Automatiser la copie des données de 45 feuilles dans une seule

Merci

Votre suggestion marche très bien aussi!

quant au temps d’exécution ce n'est pas un problème car il n'y a que 5-6 secondes entre les deux méthodes.

Cordialement

Perdinch

PS si vous avez une idée concernant la question complémentaire dans le message n'hésitez pas.

 

[Robert]

Re : vba:Automatiser la copie des données de 45 feuilles dans une seule

Bonjour le fil, bonjour le forum,

Avec le nom de l'onglet en colonne A (tu n'as pas précisé...) :

Sub Recap()
Dim og As Worksheet 'déclare la variable og (OnGlet)
Dim pe As Range 'décalre la variable pe (Plage à Effacer)
 
Application.ScreenUpdating = False 'masque les changements à l'écran
 
'*********************************
'suppression des anciennes données
'*********************************
If Sheets("Recap").Range("A2").Value <> "" Then 'condition si la cellule A2 de l'onglet "Recap" n'est pas vide
    Set pe = Sheets("Recap").Range("A2").CurrentRegion 'définit la plage pe
    pe.Clear 'efface la plage pe
End If 'fin de la condition
 
'****************************************************
'récupération des données dans les différents onglets
'****************************************************
For Each og In Sheets 'boucle sur tous les onglets du classeur
    Select Case Left(og.Name, 4) 'action en fonction des 4 premières lettres du nom de l'onglet
        Case "DATA" 'cas "DATA"
            Set dest = Sheets("Recap").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
            Range(dest, dest.Offset(999, 0)).Value = og.Name 'place le nom de l'onglet dans la colonne A
            og.Range("A1:AZ1000").Copy dest.Offset(0, 1) 'copie et colle la plage à partir de la colonne B
    End Select 'fin de l'action en fonction de...
Next og 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

Ou, avec la methode de Jean-Marie (adaptée à l'onglet Recap) :

Sub RecopieParArray()
Dim og As Worksheet, pl As Range
 
Application.ScreenUpdating = False
 
'*********************************
'suppression des anciennes données
'*********************************
If Sheets("Recap").Range("A2").Value <> "" Then 'condition si la cellule A2 de l'onglet "Recap" n'est pas vide
    Sheets("Recap").Range("A2").CurrentRegion.Clear 'efface les anciennes données
End If 'fin de la condition
 
'****************************************************
'récupération des données dans les différents onglets
'****************************************************
For Each og In Worksheets
    If Left(og.Name, 4) = "DATA" Then
        Set pl = og.Range(og.[A1], og.[AZ1000])
        Sheets("Recap").[A65536].End(xlUp).Offset(1).Resize(pl.Rows.Count, 1).Value = og.Name
        Sheets("Recap").[B65536].End(xlUp).Offset(1).Resize(pl.Rows.Count, _
            pl.Columns.Count).Value = pl.Value
    End If
    Set pl = Nothing
Next og
Application.ScreenUpdating = True
End Sub

à qui je signale au passage qu'un test comparé entre nos deux premières macros sur 10 onglets indique qu'il faut beaucoup moins de temps pour un copier /coller qu'avec sa méthode. Avec en plus dans mon code la suppression des anciennes données.