XL 2013 aide pour tableau

[jux9366]

Bien le bonjour,
Voila j'ai créer un tableau qui sera ma base sur l'onglet 'BASE'.
J'aimerais si cela est possible qu'il remplisse automatiquement mais autres tableaux qui seront sur les différents onglets "Janvier" Février etc.
serait-il possible que quand on change la date sur la base que celui ci remplisse la date concernée sur les autres onglet "Janvier Février etc. et ainsi de suite ?
Je vous joint mon fichier
Sur la base j'ai fais un VBA pour effacer automatiquement les cellules au changement de date.
Jai un niveau estimé de très nul en VBA .

Je remercie d'avance de votre aide
Cordialement

 

[vgendron]

Bonjour

un essai de code

Sub transferer()
Dim TabToTransfert() As Variant
Dim DateExport As Date
ReDim TabToTransfert(1 To 4, 1 To 4)

With Sheets("Base")
    DateExport = .Range("B2")
    Onglet = Format(DateExport, "mmmm")
    For i = LBound(TabToTransfert, 1) To UBound(TabToTransfert, 1)
        
        TabToTransfert(i, 1) = .Cells(IIf(i > 2, i + 1, i) + 5, 3) + .Cells(IIf(i > 2, i + 1, i) + 5, 4)
        TabToTransfert(i, 2) = .Cells(IIf(i > 2, i + 1, i) + 5, 5)
        TabToTransfert(i, 3) = .Cells(IIf(i > 2, i + 1, i) + 5, 6)
        TabToTransfert(i, 4) = .Cells(IIf(i > 2, i + 1, i) + 5, 7)
    Next i
End With

With Sheets(Onglet)
    Set trouve = .Cells.Find(Format(DateExport, "dddd d mmmm yyyy"), LookIn:=xlValues)
    If Not trouve Is Nothing Then
        trouve.Offset(1, 2).Resize(UBound(TabToTransfert, 1), UBound(TabToTransfert, 2)) = TabToTransfert
    End If
End With
End Sub

attention, les onglets doivent s'appeler du nom des mois SANS accent, ni majuscule

 

[jux9366]

Bonjour

un essai de code

Sub transferer()
Dim TabToTransfert() As Variant
Dim DateExport As Date
ReDim TabToTransfert(1 To 4, 1 To 4)

With Sheets("Base")
    DateExport = .Range("B2")
    Onglet = Format(DateExport, "mmmm")
    For i = LBound(TabToTransfert, 1) To UBound(TabToTransfert, 1)
       
        TabToTransfert(i, 1) = .Cells(IIf(i > 2, i + 1, i) + 5, 3) + .Cells(IIf(i > 2, i + 1, i) + 5, 4)
        TabToTransfert(i, 2) = .Cells(IIf(i > 2, i + 1, i) + 5, 5)
        TabToTransfert(i, 3) = .Cells(IIf(i > 2, i + 1, i) + 5, 6)
        TabToTransfert(i, 4) = .Cells(IIf(i > 2, i + 1, i) + 5, 7)
    Next i
End With

With Sheets(Onglet)
    Set trouve = .Cells.Find(Format(DateExport, "dddd d mmmm yyyy"), LookIn:=xlValues)
    If Not trouve Is Nothing Then
        trouve.Offset(1, 2).Resize(UBound(TabToTransfert, 1), UBound(TabToTransfert, 2)) = TabToTransfert
    End If
End With
End Sub

attention, les onglets doivent s'appeler du nom des mois SANS accent, ni majuscule

merci pour le code mais quand je le rentre cela fais rien. quand je change de date cela efface tous

 

[vgendron]

ma macro n'efface rien.. au pire, elle n'écrit rien..
il faut aller voir du coté du code déjà existant dans votre fichier

 

[vgendron]

avec une correction pour éviter qu'elle n'écrive rien justement.. ou pas au bon endroit
PS: je me suis permis de modifier l'onglet Février pour que ton tableau de synthèse à droite soit à la meme place quelque soit le mois
j'ai également modifié les formules pour les dates du jour sur la colonne AD

 

[jux9366]

avec une correction pour éviter qu'elle n'écrive rien justement.. ou pas au bon endroit
PS: je me suis permis de modifier l'onglet Février pour que ton tableau de synthèse à droite soit à la meme place quelque soit le mois
j'ai également modifié les formules pour les dates du jour sur la colonne AD

 

[jux9366]

avec une correction pour éviter qu'elle n'écrive rien justement.. ou pas au bon endroit
PS: je me suis permis de modifier l'onglet Février pour que ton tableau de synthèse à droite soit à la meme place quelque soit le mois
j'ai également modifié les formules pour les dates du jour sur la colonne AD

Bonjour
Merci pour ce retour c'est exactement ce que je voulais.
J'ai changer un peu la structure du tableau Base pour pouvoir inséré d'autres lignes sur les tableaux onglets .Pouvez vous vérifier si ce que j'ai fais est bon et si, je peux encore abuser de votre temps.pouvez vous me lier toutes les cellules qui sont en couleur sur les tableaux onglets
Cdl

 

[vgendron]

Hello
regarde le code que j'ai commenté pour expliquer

 

[jux9366]

Hello
regarde le code que j'ai commenté pour expliquer

Super merci en plus expliquer que demande le peuple..
Bonne journée et encore merci

 

[jux9366]

Hello
regarde le code que j'ai commenté pour expliquer

dsl de revenir vers vous mais quand je transfert les données après le 30/01 cela efface une partie du tableau de synthèse au niveau des dates.
Cdl

 

[vgendron]

je ne vois pas ce qui ne fonctionne pas.. je viens de faire un test avec le 31/01==> pas de souci
peux tu reposter ton fichier qui pose problème

 

[jux9366]

je ne vois pas ce qui ne fonctionne pas.. je viens de faire un test avec le 31/01==> pas de souci
peux tu reposter ton fichier qui pose problème

 

[vgendron]

ca n'efface rien.. mais ca n'écrit rien non plus.. parce que ton tableau de synthèse donne le mois de janvier de 1900

 

[jux9366]

ca n'efface rien.. mais ca n'écrit rien non plus.. parce que ton tableau de synthèse donne le mois de janvier de 1900

oui au début il est a la bonne date et après validation du transfert cela m'enlève la date du 1 er janvier et me mets en 1900. tester en remettant la date du 1/01 sur le tableau de synthèse

 

[vgendron]

Effectivement.. je ne sais pas pourquoi, mais j'avais défini un tablo à transferer de 6 colonnes.. alors que 4 sont suffisantes...

Sub transferer()
Dim TabToTransfert() As Variant
Dim DateExport As Date

ReDim TabToTransfert(1 To 6, 1 To 4) 'on définit le tableau de données à transferer

With Sheets("Base") 'avec la feuille Base
    DateExport = .Range("B2") 'on récupère la date
    Onglet = Format(DateExport, "mmmm") 'on en déduit le nom de l'onglet qui correspond au  mois de la date
    
    For i = LBound(TabToTransfert, 1) To UBound(TabToTransfert, 1) 'pour chaque ligne du tableau
        TabToTransfert(i, 1) = .Cells(i + 5, 3) + .Cells(i + 5, 4) 'on fait la somme des colonnes Desset + Fromage
        TabToTransfert(i, 2) = .Cells(i + 5, 5) 'on met la quantité des entrées
        TabToTransfert(i, 3) = .Cells(i + 5, 6) 'on met la quantité des légumes
        TabToTransfert(i, 4) = .Cells(i + 5, 7) 'on met la quantité des viandes
    Next i
    PetitDej = .Range("A6") 'on récupère le petit dej
    PersVeilleur = .Range("A10") 'on récupère la donnée
    TotalJournée = .Range("A14") 'on récupère la donnée
    TotalPatient = .Range("A18") 'on récupère la donnée
End With

With Sheets(Onglet) 'dans la feuille adéquate
    '.Activate
    Set trouve = .Range("B:AI").Find(Format(DateExport, "dddd d mmmm yyyy"), LookIn:=xlValues) 'on cherche la date dans les colonnes B à AI
   
    If Not trouve Is Nothing Then 'si on trouve la date
        'MsgBox trouve.Address
        trouve.Offset(1, 2).Resize(UBound(TabToTransfert, 1), UBound(TabToTransfert, 2)) = TabToTransfert 'on colle le tablo à la bonne place (on se décalle par rapport à la date
        trouve.Offset(8, 1) = PetitDej 'on colle le petitdej
    End If
    Set trouve = .Range("AK23:AK53").Find(Format(DateExport, "dddd d mmmm yyyy"), LookIn:=xlValues) 'on cherche la date dans le tableau de synthèse (entre AK23 et AK53)
    If Not trouve Is Nothing Then 'si on trouve la date
     'MsgBox trouve.Address
        trouve.Offset(0, 2) = TotalJournée 'on place les infos
        trouve.Offset(0, 3) = TotalPatient
        trouve.Offset(0, 6) = PersVeilleur
    End If
End With
End Sub