XL 2010 Macro copier coller tableau avec Inputbox

[Schaumberger Philip]

Bonjour,
Je suis nouveau sur le forum ainsi qu'un novice sur excel et je viens chercher votre aide.
Je cherche a créer une macro capable de copier coller un tableau à l'appui d'un bouton simplement.

Voici quelques précisions sur le fichier en PJ.

A l'appui du bouton, la macro m'affiche une InputBox demandant la date d'aujourd'hui. Celle ci doit venir se coller en D24 avec tout le reste du tableau (A3:BL23). Cette manipulation doit être refaite tout les jours sans effacer les données précédentes. En gros, 21 lignes doivent s'ajouter aux tableau tout les jours, à la suite des jours précédents.

Quelqu'un ici peut-il m'aider à réaliser cette macro ?

Dans tout les cas merci beaucoup de votre temps et de votre patience !

Cordialement,
Philip

 

[Lone-wolf]

Bonjour Philip et bienvenue sur XLD

@Schaumberger Philip

Je ne sais pas si tu travail sur MAC, mais fait un test avec le fichier pour voir si sa fonctionne. Il faudra aussi corriger certaines formules.

Note: j'ai mis la formule =AUJOURDHUI() en D2. Pour filtrer les données, double-clique sur un colonne de ton choix (mis à part la colonne A) et la cellule de critère. Pour supprimer le filtre, clique sur la cellule A2.

 

[Schaumberger Philip]

Bonjour Lone-Wolf,

Un grand merci pour ton intérêt à mon problème et ta solution apportée

En effet je travaille sur mac, la formule marche très bien, malgré quelques petits soucis.

Est il possible d'intégrer à la macro la copie des colonnes BL et BK ? Celle ci me sont nécessaire au calcul de la colonne BF. Est-il nécessaire de les intégrer au tableau pour cela ? (Ca ne poserait aucun problème).
De plus, lors du copier-coller, les données des cellules jaunes sont également transférés. Serait-il possible de baser ce copier-coller sur un tableau lambda (Cellules jaunes vides mais les cellules blanches contiennent encore les formules) dans l'objectif d'avoir un tableau vierge de données à remplir.

Si jamais cela est trop contraignant, ne vous cassez pas la tête dessus !!
Encore un grand merci pour votre temps !!!!

Cordialement,
Philip

 

[Schaumberger Philip]

De plus je viens de remarquer que lorsque j'entre plusieurs dates, seulement la dernière entrée reste sur le tableau.
Voici un exemple, j'ai rentré d'abord le 28 Août 2018, ensuite le 3 Juin 2019, ensuite le 29 Août 2018. On ne retrouve que le 29 Août sur l'intégrité du tableau hormis les 21 premières lignes.

Cordialement,
Philip

 

[Lone-wolf]

Re Philip

En ce que concerne l'autre tableau, non, il faut le copier à part.

De plus, lors du copier-coller, les données des cellules jaunes sont également transférés. Serait-il possible de baser ce copier-coller sur un tableau lambda (Cellules jaunes vides mais les cellules blanches contiennent encore les formules)

De quelle cellules jaune tu parle? Et si c'est juste la mise en forme et les formules que tu veux copier, il faut enlever la ligne xlPasteValues.

Ce que je ne comprends pas, si c'est un planning journalier, pourquoi 3 juin 2019??

 

[Schaumberger Philip]

Re Lone-Wolf

Les cellules jaunes représentent les cases à remplir manuellement, donc à l'idéale il faudrait que celle-ci soit vides pour une saisie optimale.
Si j'ai rentrer cette date un peu aléatoire c'était simplement pour tester, en cas d'oubli, si l'on pouvait entrer une date antérieure à la date précédente. ^^

 

[Lone-wolf]

Re

Voilà, j'ai corrigé la macro et ajouté l'autre tableau; cette fois c'est OK.

Note: si le premier tableau est supérieur à 23, il faudra corriger les lignes dans la macro.

EDIT: au cas où.

Option Explicit

Sub AjoutDate()
Dim maDate As Date, tablo As Range, tbl As Range, cel As Range
Dim i&, k&, col&, fin&, lignes&, lig&, dt As Date, c As Range

    Application.ScreenUpdating = False

    maDate = InputBox("Veuillez entrer la date du jour.", "Nouveau Tableau")

    On Error Resume Next
   
    lignes = Range("a3").End(xlDown).Row
    Set tablo = Range("a3:bi" & lignes)

    tablo.Copy
    Set cel = Range("a" & Rows.Count).End(xlUp)(2)
    cel.PasteSpecial xlPasteFormulas
    cel.PasteSpecial xlPasteFormats

    lig = Range("bk3").End(xlDown).Row
    Set tbl = Range("bk3:bp" & lig)

    tbl.Copy
    Set c = Range("bk" & Rows.Count).End(xlUp)(2)
    c.PasteSpecial xlPasteFormulas
    c.PasteSpecial xlPasteFormats
    Application.CutCopyMode = 0

    dt = DateSerial(Year(maDate), Month(maDate), Day(maDate))
    fin = Cells(Rows.Count, 4).End(xlUp).Row
    For i = cel.Row To cel.Row + 21
        If Cells(i, "A") <> "" Then
            For k = i To fin
                Cells(k, "D") = CDate(dt)
                For col = 1 To 61
                    If Cells(k, col).Interior.Color = vbYellow Then Cells(k, col).ClearContents
                Next col
                For col = 65 To 68
                    Cells(k, col).ClearContents
                Next col
            Next k
        End If
    Next i
    Application.Goto Range("a1")
End Sub

 

[Schaumberger Philip]

Un GRAND GRAND merci à toi ! Je ne sais comment te remercier !