Copier coller selon date
Bonjour a tous,
Afin de m'améliorer, je voulais savoir si il était possible de faire une macro qui copie/colle sur une autre feuille un ensemble de données des qu'une date est passée.
La tableau serait un tableau qui changerait régulièrement donc, a la date voulue ça copierait les valeurs qui sont présente, mais qui pourrais changer 2-3 semaines plus tard.
J’espère que c'est clair.
Je n'ai pas de fichier en exemple pour vous donnez la base.
Merci
Evidemment !...
Je n'ai pas de fichier en exemple pour vous donnez la base.
Il faudra donc en construire un !
S'agissant de valeurs, le copier-coller ne s'impose pas, une affectation directe sera plus rapide...
Cordialement.
Voila un tableau que j'ai fait.
Dans l'onglet Listing c'est le tableau qui change.
Et j'aimerais que le 22/08 la plage nom et prénom se copie colle dans l'onglet 2017 et ainsi de suite pour toutes les années qui suivront, mais comme le listing va bouger.
Bonjour,
Puisque la date ne figure pas dans le fichier, mais seulement dans ta tête !
Sub Copier()
Dim ws As Worksheet, Tbl
Set ws = Worksheets(CStr(Year(Date)))
ws.Range("A1").CurrentRegion.Clear
With ActiveSheet
Tbl = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1))
End With
With ws.Range("A1").Resize(UBound(Tbl, 1), UBound(Tbl, 2))
.Value = Tbl
.Borders.Weight = xlThin
.Worksheet.Activate
End With
End Sub
Tu noteras (c'est utile !) que malgré l'intitulé, on ne copie pas, et on ne colle pas plus ! C'est à dire que l'on n'utilise pas le presse-papier de Windows pour y faire transiter les données. On les place dans un tableau, qu'on affecte ensuite directement à la feuille cible.
Cordialement.
Merci,
Si jamais j'y appose une date par année y a t il moyen de le faire automatiquement? Je joins le fichier initiale avec les dates.
Car ce ne sont pas des dates que j'ai en tête, je me doutais bien qu'il fallait les encoder quelque part...
Encore merci de la réponse rapide.
Je ferais attention de ne plus dire un copier coller....
Si c'est à date fixe, besoin de rien, on détecte automatiquement la date et on fait l'opération.
D'abord :
Private Sub Workbook_Open()
Dim d
If Month(Date) = 8 Then
d = DateSerial(Year(Date), 8, 1)
d = d - Weekday(d) + 25
If d = Date Then
MsgBox "Date de clôture atteinte, la feuille annuelle va être créée.", _
vbInformation, "Listing annuel"
CopierListing d
End If
End If
End Sub
A placer dans le module ThisWorkbook, qui vérifiera à l'ouverture du classeur si l'on est en août, si c'est le cas si la date (mercredi précédant le 4e samedi du mois) est atteinte. Dans ce cas, elle prévient, puis lance la procédure de création de la feuille annuelle.
La procédure :
Sub CopierListing(d)
Dim Tbl
With Worksheets("Listing")
Tbl = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1))
End With
Application.ScreenUpdating = False
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Range("A2").Resize(UBound(Tbl, 1), UBound(Tbl, 2)).Value = Tbl
.Range("A1") = "Date clôture": .Range("B1") = d
.Range("B1").NumberFormat = "dd/mm/yyyy"
With Range("A1:B1")
.Font.Color = vbRed: .Font.Bold = True: .Interior.Color = RGB(174, 170, 170)
.Resize(UBound(Tbl, 1) + 1).Borders.Weight = xlThin
End With
.Name = Year(Date)
End With
End Sub
Celle-ci dans un module standard. Elle procède comme précédemment en prélevant les données dans un tableau, puis ajoute une feuille, affecte le tableau, ajoute les mentions de 1re ligne... et nomme la feuille.
Cordialement.