XL 2010 Aide macro copier des cellules d'onglet dans un autre onglet

medinmars

XLDnaute Nouveau
Bonjour,

Je voudrais faire une macro qui permettrait de copier coller automatiquement des cellules d'onglets les unes à la suite des autres dans un autre onglet.

Voici un petit exemple.
La plage de données de chaque onglet va varier

Merci pour votre aide :)
 

Fichiers joints

Jacky67

XLDnaute Accro
Bonjour,

Je voudrais faire une macro qui permettrait de copier coller automatiquement des cellules d'onglets les unes à la suite des autres dans un autre onglet.

Voici un petit exemple.
La plage de données de chaque onglet va varier

Merci pour votre aide :)
Bonjour,
Cela pourrait ressembler à ceci:
Code:
Sub CopieJJ()
    Dim sh As Worksheet, Derlg As Long
    Sheets("Tous").Activate
    Cells.Clear
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> ActiveSheet.Name Then
            Derlg = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
            sh.Range("a1:d" & Derlg).Copy
            Range("a" & Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 

Fichiers joints

Dernière édition:

MAHARO

XLDnaute Nouveau
Bonjour a tous ce sujet se rapporche de ce que je cherche a avoir,
J'ai un macro dans mon fichier qui donne un resUltat (voir onglet RESUME),sauf que je souhaite le resultat (voir onglet RESULTAT CHERCHE)
en esperant de reponse de votre part , j'ai joint le fichier
Cordialement.
 

Fichiers joints

Jacky67

XLDnaute Accro
Bonjour,
Essaye ceci

VB:
Sub presentation()
    Dim Sh As Worksheet, Lig&
    Application.ScreenUpdating = False
    Sheets("RESUME").Cells.Clear
    Lig = 1
    For Each Sh In Sheets(Array("janvier", "fevrier", "mars")) 'ici ajouter le nom(exact) des feuilles s'il y a lieu
        With Sheets("RESUME")
            .Cells(Lig, 1) = Sh.Name
            .Range(.Cells(Lig, 1), .Cells(Lig, 4)).HorizontalAlignment = xlCenterAcrossSelection
            Lig = Lig + 1
            Sh.UsedRange.Copy .Cells(Lig, 1)
            Lig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
        End With
    Next
    Application.ScreenUpdating = True
End Sub
*Ajouté...
Une version (V2) qui tient compte des éventuels mois ajouter sans avoir à modifier le code.
A condition que les noms de feuille soient rédigés par un nom de mois reconnu.
"février" et non pas "fevrier" "août" et non pas "aout" etc....
 

Fichiers joints

Dernière édition:

MAHARO

XLDnaute Nouveau
Merci bien ,Cette reponse me vas tres bien ,mais avec ce piece jointe comment ca va se passer
Ca me recoipie les valeurs mais je cherche a avoir seulement le resultat ci dessous

n°tvxtypelieudate


Cordialement
 

Fichiers joints

Discussions similaires


Haut Bas