Macro de remplissage

Bonjour a tous et toutes,

Je débute dans la création de Macro Excel et je souhaite créer une macro me permettant de remplir plusieurs tableau dans des onglets différents par rapport au nom des onglets ainsi que le contenu.

Dans ma feuille "Extract" je rentre diverses informations.

Ce que je veux c'est que pour chaque information rentrées dans l'onglet "Extract" en cliquant sur un bouton tout se rentre dans les différents onglets.

En gros je veux automatiser un copier/coller

Si une âme charitable avait la solution (avec les explications de préférence afin de pouvoir reproduire si besoin est) cela me rendrait un immense service!!!

Merci a toi

Aucune ame charitable pour me donner un coup de main??????????

Bonsoir,

Mon avis : opération simple mais que ta mise en forme complique inutilement...

Cordialement.

Bonjour,

A tester. Comme le dit MFerrand, la mise en forme de tes feuilles n'est pas des plus simple et peux même poser problème quand un ou plusieurs tableaux seront plein, avec mon code bien sûr mais regarde malgré tout si ça convient :

Sub Test()

    Dim FeExtract As Worksheet
    Dim FeCible As Worksheet
    Dim PlgExtract As Range
    Dim PlgCible As Range
    Dim CelExtract As Range
    Dim CelCible As Range
    Dim CelVal As Range

    'initialise la variable sur la feuille d'extraction
    Set FeExtract = Worksheets("Extract")

    'défini la plage sur la feuille d'extraction en colonne F (6) de F7 à Fx
    With FeExtract: Set PlgExtract = .Range(.Cells(7, 6), .Cells(.Rows.Count, 6).End(xlUp)): End With

    'boucle sur les cellules de la plage
    For Each CelExtract In PlgExtract

        'défini la feuille cible en fonction du nom situé en colonne F
        Set FeCible = Worksheets(CelExtract.Value)

        'comme la feuille est construite de façon particulière, la définition de la plage
        'est faite sur toute la feuille (recherche de la cellule la plus à droite et la plus basse)
        Set PlgCible = DefPlage(FeCible, 1, 1)

        'on pourrait utiliser la propriété Find() mais trop capricieuse avec les dates surtout si elles
        'sont issues de formule
        For Each CelCible In PlgCible

            'si correspondance de date...
            If CelCible.Value2 = CelExtract.Offset(, -4).Value2 Then

                'défini la 1ère cellule vide sous celle contenant la date
                'attention, avec le montage particulier des feuilles, il pourrait
                'y avoir problème quand un ou plusieurs tableaux remplis
                Set CelVal = CelCible.End(xlDown).Offset(1)

                'inscription des valeurs
                CelVal.Offset(, -1).Value = CelExtract.Offset(, -3).Value
                CelVal.Value = CelExtract.Offset(, -2).Value
                CelVal.Offset(, 1).Value = CelExtract.Offset(, -1).Value

            End If

    Next CelCible, CelExtract

End Sub

Function DefPlage(Fe As Worksheet, L As Long, C As Long) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Bonjour Theze,

Je te remercie de tout cœur(même si malheureusement je ne comprend pas trop se que tu as créé mais j 'essaie tout de même).

Elle fonctionne parfaitement.

Je vais l'adapter a mon classeur déjà en place.

Concernant les petit problème dû a la mise en forme particulière je verrais au fur et a mesure sachant que je crée un nouveau classeur chaque semaine.

En tout cas vous êtes vraiment au top !!!!

Encore merci