XL 2013 aide pour tableau

jux9366

XLDnaute Nouveau
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
 

Pièces jointes

  • Base 2021.xlsm
    168.6 KB · Affichages: 8
Solution
Effectivement.. je ne sais pas pourquoi, mais j'avais défini un tablo à transferer de 6 colonnes.. alors que 4 sont suffisantes...

VB:
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)...

jux9366

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

VB:
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
merci ca fonctionne..
et excuser moi d'être embêtant a quoi correspond ces tableaux 1 to 6 a celui de la base et 1 to 4 dans onglets ?
TabToTransfert(1 To 6, 1 To 4)
 

vgendron

XLDnaute Barbatruc
nouvelle correction ci dessous: en ne mettant que 4 lignes et 4 colonnes

le tableau est une structure vba qui permet de récuperer les données
tablo (1 to nbLignes, 1 to NbColonnes)



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

ReDim TabToTransfert(1 To 4, 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
 

jux9366

XLDnaute Nouveau
nouvelle correction ci dessous: en ne mettant que 4 lignes et 4 colonnes

le tableau est une structure vba qui permet de récuperer les données
tablo (1 to nbLignes, 1 to NbColonnes)



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

ReDim TabToTransfert(1 To 4, 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
Merci vous n'avez beaucoup appris
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 184
dernier inscrit
Di Martino