Macro pour copier des données de différentes feuilles

Bonjour à tous, je suis nouveau sur le forum, est bien sur novice en programmation Excel-VBA.

Je suis à la recherche d'une Macro, afin de copier des données de différentes feuilles EXCEL vers une seule feuille.

Je joints à ma demande 2 fichiers EXCEL pour comprendre ma demande au format EXCEL 97_2003 et 2007

Par avance merci de vos réponses

Nota : je trouve ce forum très intéressant.

Bonsoir.

Salut,

voici un exemple (le code n'est pas optimisé : meilleur comprhension)

Dis moi si c'est ce que tu souhaites.

Big

Bonjour à tous,

A quoi sert "Résu4" ?

apparemment, c'est les mêmes données que "Résu3" sans les commentaires

Amicalement

Claude

Par avance merci pour vos réponses.

Pour "dubois" la feuille "Résu3" est issue d'une importation de fichier et pas tout à fait identique de la feuille "Résu4" car il manque des feuilles de mon application. Je bugg sur le copier/coller. en résumer l’ensemble de mon fichier EXCEL sert sur la gestion d'indicateur sur des activités.

Le fichier de "Bigdams" est pas tout a fait ce que je recherche, je pense que je me suis louper dans mes explications.

En résumer je recherche une Macro afin de copier/coller une partie des données issues de plusieurs feuilles EXCEL d'un même fichier :

1) Copier les données de la feuille "Résu4" dans "Résultat"

2) Copier les données de la colonne J (Commentaire) de la feuille "Résu3" dans "Résultat" qui doivent être coller sur les mêmes lignes de la feuilles copiée précédemment "Résu4".

3) Copier les données de la feuille "Résu" dans "Résultat" à la suite des données copiées précédemment.

Merci par avance.

Bonsoir à tous,

On commence par mettre à jour "Résu4" avec les commentaires de "Résu3"

ensuite, on copie les 2 feuilles dans "Résultat"

J'ai trié différemment la feuille "Résu3" (pour tester)

Sub Récap()
Dim f1 As Worksheet, f3 As Worksheet, f4 As Worksheet
Dim Lg&, i&, c As Range
    Application.ScreenUpdating = False
    Set f1 = Sheets("Résu")
    Set f3 = Sheets("Résu3")
    Set f4 = Sheets("Résu4")

    '--- mise à jour feuille "Résu4" (commentaire "Résu3")---
    With f4
        Lg = .Range("a" & Rows.Count).End(xlUp).Row
        For i = 2 To Lg
            Set c = f3.Columns("a").Find(.Cells(i, "a"), LookIn:=xlValues, Lookat:=xlWhole)
            If Not c Is Nothing Then
                .Cells(i, "j") = f3.Cells(c.Row, "j")
            End If
        Next i
    End With

    '--- copie dans Résultat ---
    With Sheets("Résultat")
        .Range("a2:k" & .[a65000].End(xlUp).Row + 1).Clear
        f4.Range("a2:k" & f4.[a65000].End(xlUp).Row) _
        .Copy Destination:=.Range("a" & Rows.Count).End(xlUp)(2)

        f1.Range("a2:k" & f1.[a65000].End(xlUp).Row) _
        .Copy Destination:=.Range("a" & Rows.Count).End(xlUp)(2)
    End With
End Sub

à voir si il y aura davantage de feuilles ?

et si elles se nommeront toujours pareil.

Amicalement

Claude

104pyramide33-recap.xlsm (59.79 Ko)

re,

Autre version, sans modifier "Résu4"

Sub Récap()
Dim f1 As Worksheet, f3 As Worksheet, f4 As Worksheet
Dim Lg&, i&, c As Range
    Application.ScreenUpdating = False
    Set f1 = Sheets("Résu")
    Set f3 = Sheets("Résu3")
    Set f4 = Sheets("Résu4")

    With Sheets("Résultat")
        '--- copie "Résu4" dans Résultat ---
        .Range("a2:k" & .[a65000].End(xlUp).Row + 1).Clear
        f4.Range("a2:k" & f4.[a65000].End(xlUp).Row) _
        .Copy Destination:=.Range("a" & Rows.Count).End(xlUp)(2)

        '--- ajout commentaires de "Résu3" ---
        Lg = .Range("a" & Rows.Count).End(xlUp).Row
        For i = 2 To Lg
            Set c = f3.Columns("a").Find(.Cells(i, "a"), LookIn:=xlValues, Lookat:=xlWhole)
            If Not c Is Nothing Then
                .Cells(i, "j") = f3.Cells(c.Row, "j")
            End If
        Next i
        '--- copie "Résu" dans Résultat ---
        f1.Range("a2:k" & f1.[a65000].End(xlUp).Row) _
        .Copy Destination:=.Range("a" & Rows.Count).End(xlUp)(2)
    End With
End Sub

Claude

Rechercher des sujets similaires à "macro copier donnees differentes feuilles"