Transférer des données de deux feuilles excels sur une autre feuille

Bonjour à tous,

J'espère que vous allez bien. Voilà, j'ai une question, j'aimerais transférer des données de deux feuilles excels sur une autre feuille. Tout cela en ne mettant que les cases avec quelque chose à l'intérieur, donc en n'affichant pas les cases vides.

Ici, dans le fichier que j'ai joint : les éléments des tableaux des feuilles Data 1 et Data 2 sur la feuille Recap.

Malheureusement, après avoir chercher sur internet en Français comme en Anglais, je n'arrive pas à trouver de solution.

Est-ce que quelqu'un a une idée ?

Merci d'avance pour votre aide :)

Bonne journée

Hello, ma propal

Si tu crées d'autres onglets "Data" ca marchera aussi par contre si t'en as qui ne doivent pas rentrer dans la consolidation faudra toucher le code

@+

Salut Baroute,

Merci beaucoup pour ton aide :)

Je suis nouveau sur le forum, et c'est vrai que j'ai peut-être oublié de mettre certain détails.

J'ai essayé de bidouiller un peu ton code mais je n'arrive pas à modifier un truc :

En gros, les tableaux ne sont pas toujours au même endroit, est-ce que tu sais comment le modifier sur le code ? Egalement, Il n'y a pas que des feuilles de Data sur le fichier.

Je te joints l'exemple dont je parle. Si tu peux m'aider pour régler ça ce serait top

Hello j'espère que ça répond mieux à ton besoin..

Un peu rudimentaire car je dois trouver la cellule data mais sinon c'est ok

N'hésite pas si besoin

@+

Merci beaucoup, c'est presque ça juste, je ne veux pas qu'il prenne les valeurs en dehors du tableau.

C'est à dire que il ne doit que prendre en compte les valeurs de chaque tableau, si j'en rajoute elles ne doivent pas y apparaître.

Je sais pas si tu sais comment je peux faire ?

Hum....

A chaque fois le tableau fait 9 lignes et pas une de plus ?

Je ne comprends pas bien..

Oui c'est ça, fin c'est 11 lignes en vrai mais sur l'exemple j'en ai mis 9

En gros à chaque fois c'est deux tableaux de 9 lignes et qui doivent se mettre sur un de 18

Ah yes dans ce cas, dans le bloc 'Data 1' et dans le bloc 'Data 2' il faut que tu remplaces cette ligne :

Derniere_ligne = ActiveSheet.Range(cell_data_value & Rows.Count).End(xlUp).Row

par

Derniere_ligne = cell_data_ligne + 9

Si jamais c'est 11 tu changes le 9 par 11 etc... En fait je déterminais dynamiquement le nombre de ligne de ton tableau, là ce sera fixe

Essaie et dis moi si c'est ok :)

ça ne fonctionne pas :/

J'ai une erreur '1004'; Application-defined or object-defined error,

J'ai modifié ton code avec mon fichier (la page recap commence en E10 sur le mien), je te mets mon code ci-dessous, si tu sais m'aider :)

Sub compilation2()

Application.ScreenUpdating = False

Sheet_recap = Sheets("Overzicht NIEUW").Name
Sheet_data_1 = Sheets("Team82 (201-206)").Name
Sheet_data_2 = Sheets("Team83 (207-214)").Name

'Partie Data 1
Sheets(Sheet_data_1).Select

    Range("A10").Select
        Cells.Find(What:="Beschrijving/Description", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    cell_data = ActiveCell.Address
    cell_data_ligne = ActiveCell.Row
    cell_data_value = Replace(cell_data, "$", "")
    cell_data_value = Replace(cell_data_value, cell_data_ligne, "")

    Derniere_ligne = cell_data_ligne + 11

    For i = cell_data_ligne + 1 To Derniere_ligne

        If Range(cell_data_value & i) <> "" Then

            nb_ligne_recap = Sheets(Sheet_recap).Range("E16" & Rows.Count).End(xlUp).Row
            ActiveSheet.Range(cell_data_value & i).Copy Sheets(Sheet_recap).Range("E16" & nb_ligne_recap + 1)

        End If

    Next i

'Partie Data 2
Sheets(Sheet_data_2).Select

    Range("A10").Select
        Cells.Find(What:="Beschrijving/Description", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    cell_data = ActiveCell.Address
    cell_data_ligne = ActiveCell.Row
    cell_data_value = Replace(cell_data, "$", "")
    cell_data_value = Replace(cell_data_value, cell_data_ligne, "")

    Derniere_ligne = cell_data_ligne + 11

    For i = cell_data_ligne + 1 To Derniere_ligne

        If Range(cell_data_value & i) <> "" Then

            nb_ligne_recap = Sheets(Sheet_recap).Range("E16" & Rows.Count).End(xlUp).Row
            ActiveSheet.Range(cell_data_value & i).Copy Sheets(Sheet_recap).Range("E16" & nb_ligne_recap + 1)

        End If

    Next i

Sheets(Sheet_recap).Select

Application.ScreenUpdating = True
End Sub

Hello

J'ai créé une autre sub (compilation3) avec ton code et je t'ai marqué les lignes où tu avais fait une erreur, en vert dans la macro

Essaie avec ça

Merci :)), Juste je crois que tu as oublié de mettre le fichier

Ah oui en effet =D

ça ne fonctionne tjrs pas, j'ai la même erreur...

Egalement le code prends bien le début à E16 ?

Sub compilation3()

Application.ScreenUpdating = False

Sheet_recap = Sheets("Overzicht NIEUW").Name
Sheet_data_1 = Sheets("Team82 (201-206)").Name
Sheet_data_2 = Sheets("Team83 (207-214)").Name

'Partie Data 1
Sheets(Sheet_data_1).Select

    Range("A10").Select
        Cells.Find(What:="Beschrijving/Description", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    cell_data = ActiveCell.Address
    cell_data_ligne = ActiveCell.Row
    cell_data_value = Replace(cell_data, "$", "")
    cell_data_value = Replace(cell_data_value, cell_data_ligne, "")

    Derniere_ligne = cell_data_ligne + 9 'tu n'as pas changé la ligne

    For i = cell_data_ligne + 1 To Derniere_ligne

        If Range(cell_data_value & i) <> "" Then

            nb_ligne_recap = Sheets(Sheet_recap).Range("E" & Rows.Count).End(xlUp).Row 'Tu avais mis Range("E16" & Rows.Count) au lieu de "E", le rows.count c'est déjà la ligne
            ActiveSheet.Range(cell_data_value & i).Copy Sheets(Sheet_recap).Range("E" & nb_ligne_recap + 1) 'Tu avais mis Range("E16" & nb_ligne_recap + 1) au lieu de "E", le nb_ligne_recap + 1 c'est déjà la ligne d'après

        End If

    Next i

'Partie Data 2
Sheets(Sheet_data_2).Select

    Range("A10").Select
        Cells.Find(What:="Beschrijving/Description", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    cell_data = ActiveCell.Address
    cell_data_ligne = ActiveCell.Row
    cell_data_value = Replace(cell_data, "$", "")
    cell_data_value = Replace(cell_data_value, cell_data_ligne, "")

    Derniere_ligne = ActiveSheet.Range(cell_data_value & Rows.Count).End(xlUp).Row

    Derniere_ligne = cell_data_ligne + 9 'tu n'as pas changé la ligne

    For i = cell_data_ligne + 1 To Derniere_ligne

        If Range(cell_data_value & i) <> "" Then

            nb_ligne_recap = Sheets(Sheet_recap).Range("E" & Rows.Count).End(xlUp).Row 'Tu avais mis Range("E16" & Rows.Count) au lieu de "E", le rows.count c'est déjà la ligne
            ActiveSheet.Range(cell_data_value & i).Copy Sheets(Sheet_recap).Range("E" & nb_ligne_recap + 1) 'Tu avais mis Range("E16" & nb_ligne_recap + 1) au lieu de "E", le nb_ligne_recap + 1 c'est déjà la ligne d'après

        End If

    Next i

Sheets(Sheet_recap).Select

Application.ScreenUpdating = True
End Sub

Ah yes, dans la recopie t'as du modifié la mauvaise ligne, t'as fait sauté l'instruction "FOR....."

Essaie ca on va y arriver ;)

Toujours pas

Huuuum....

Je pense que je peux rien faire sans ton fichier...

Ok, je t'ai mis le fichier.

En gros les valeurs des deux tableaux/cases bleues doivent aller dans le tableau violet

Merci énormément pour ton aide en tout cas :)

Hello ...🤣

Normal que ça fonctionne pas, tu m'as achevé ça y est ^^

Normalement dans la cellule encadrée en rouge ci-dessous il va chercher "Data", toi dans ton exemple tu as mis "Beschrijving/Description". Cette instruction permet de trouver en quelle cellule ton tableau bleu commence donc faut que tu lui mettes un nom en particulier (dans l'encadré rouge)

'Partie Data 1

Sheets(Sheet_data_1).Select

Range("A10").Select

Cells.Find(What:="Beschrijving/Description", => Ici dans mon exemple j'avais mis Data et dans l'onglet il y avait Data sur la cellule au dessus du tableau. Modifie ca

Désolé, j'avais bien compris haha c'est juste en enlevant les données du tableau, j'ai aussi enlevé le titre.

Malheureusement ça ne fonctionne pas, je vous remets le fichiers avec les tableaux, mais je ne vois vraiment pas ce qui ne va pas...