Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date

Sylvain. B · 11 Avril 2023

Bonjour à toute la communauté,

J'aimerais faire en sorte qu'une plage de cellules se situant de C9 à S9 de la feuille 1 appelée "CA" soit copiée/collée dans un autre onglet en fonction de la date qui se trouve en A7 de la feuille "CA", dans chaque onglets mensuels les dates se situent en colonne B.
Il faudrait parcourir chacun des onglets du classeur (hors feuille "CA") et copier ces cellules sur la ligne correspondante à cette date toujours de la colonne C à la colonne S.

Pourriez-vous m'aider s'il vous plaît ?
Je vous joins un exemple pour mieux comprendre car il me semble que je ne suis pas très clair

Merci à toutes et tous pour votre aide et/ou vos idées.

J'ai commencé en écrivant le code ci-dessous mais je débute et j'ai du mal à terminer ou même à le faire fonctionner avec mon niveau de connaissance :

Sub CopierCollerDansChaqueOnglet()

'Déclaration des variables
Dim feuilleCA As Worksheet
Dim feuilleMensuel As Worksheet
Dim dateCopier As Date
Dim ligneCopier As Integer
Dim onglet As Worksheet

'Définition de la feuille de travail CA
Set feuilleCA = ThisWorkbook.Sheets("CA")

'Récupération de la date à partir de la cellule A7 de la feuille CA
dateCopier = feuilleCA.Range("A7").Value

'Parcours de chaque feuille de travail
For Each onglet In ThisWorkbook.Worksheets

'Vérification si la feuille est différente de la feuille CA
If Not onglet.Name = feuilleCA.Name Then

'Recherche de la ligne correspondante dans l'onglet courant
'Définition de la plage de recherche (ici colonne A)
Set plageRecherche = onglet.Range("B:B")

'Recherche de la valeur dans la plage de recherche
Set resultat = plageRecherche.Find(What:=recherche, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)

'Copie des cellules de C2 à S2 dans la ligne correspondante de l'onglet courant
feuilleCA.Range("C2:S2").Copy Destination:=onglet.Range("C" & ligneCopier)

End If

Next onglet

End Sub

job75 · 12 Avril 2023

Bonjour Sylvain. B,

La macro affectée au bouton :

VB:

Sub Copier()
Dim dat As Variant, P As Range, i As Long
With Sheets("CA")
    dat = .[A7]
    If Not IsDate(dat) Then Exit Sub
    dat = CLng(CDate(dat))
    Set P = .[D3:T3]
End With
On Error Resume Next
With Sheets(Format(dat, "mmmm"))
    If Err Then MsgBox "Feuille " & UCase(Format(dat, "mmmm")) & " inexistante !", 48: Exit Sub
    i = Application.Match(dat, .[B:B], 0)
    If i = 0 Then MsgBox "Date introuvable !", 48: Exit Sub
    .Cells(i, 3).Resize(, P.Columns.Count) = P.Value 'copier-coller des valeurs
    Application.Goto .Cells(i, 2) 'selection facultative
End With
End Sub

A+

job75 · 11 Avril 2023

Bonjour Sylvain. B,

En feuille "CA' je vois la plage C3:R3 mais il n'y a rien en C9:S9, que faut-il donc faire ?

A+

Sylvain. B · 12 Avril 2023

job75 à dit:
Bonjour Sylvain. B,

En feuille "CA' je vois la plage C3:R3 mais il n'y a rien en C9:S9, que faut-il donc faire ?

A+

Bonjour Job75,

En effet, autant pour moi, désolé.
La plage de données à copier/coller se situe en D3:T3 de la feuille "CA".
J'ai légèrement modifié l'exemple pour qu'il soit plus clair enfin je l’espère.

Merci à vous, excellente journée.

job75 · 12 Avril 2023

Bonjour Sylvain. B,

La macro affectée au bouton :

VB:

Sub Copier()
Dim dat As Variant, P As Range, i As Long
With Sheets("CA")
    dat = .[A7]
    If Not IsDate(dat) Then Exit Sub
    dat = CLng(CDate(dat))
    Set P = .[D3:T3]
End With
On Error Resume Next
With Sheets(Format(dat, "mmmm"))
    If Err Then MsgBox "Feuille " & UCase(Format(dat, "mmmm")) & " inexistante !", 48: Exit Sub
    i = Application.Match(dat, .[B:B], 0)
    If i = 0 Then MsgBox "Date introuvable !", 48: Exit Sub
    .Cells(i, 3).Resize(, P.Columns.Count) = P.Value 'copier-coller des valeurs
    Application.Goto .Cells(i, 2) 'selection facultative
End With
End Sub

A+

job75 · 12 Avril 2023

Il faudra faire attention pour les mois de FÉVRIER et DÉCEMBRE qu'il y ait bien les accents...

Sylvain. B · 12 Avril 2023

job75 à dit:

Bonjour Sylvain. B,

La macro affectée au bouton :

VB:

Sub Copier()
Dim dat As Variant, P As Range, i As Long
With Sheets("CA")
    dat = .[A7]
    If Not IsDate(dat) Then Exit Sub
    dat = CLng(CDate(dat))
    Set P = .[D3:T3]
End With
On Error Resume Next
With Sheets(Format(dat, "mmmm"))
    If Err Then MsgBox "Feuille " & UCase(Format(dat, "mmmm")) & " inexistante !", 48: Exit Sub
    i = Application.Match(dat, .[B:B], 0)
    If i = 0 Then MsgBox "Date introuvable !", 48: Exit Sub
    .Cells(i, 3).Resize(, P.Columns.Count) = P.Value 'copier-coller des valeurs
    Application.Goto .Cells(i, 2) 'selection facultative
End With
End Sub

A+

Bonjour Job75,

Ça fonctionne parfaitement, vous êtes au top
Merci beaucoup pour votre aide, vraiment je vais gagner pas mal de temps grâce à vous.
Je vous souhaite une excellente journée et vous remercie infiniment.

Sylvain. B · 12 Avril 2023

job75 à dit:
Il faudra faire attention pour les mois de FÉVRIER et DÉCEMBRE qu'il y ait bien les accents...

Oui les onglets Février et Décembre ont bien leurs accents en revanche au sein de la feuille ce n'est pas le cas. Dois-je le modifier ?

job75 · 12 Avril 2023

Si le nom doit être utilisé pour rechercher la feuille il faut l'accent.

Sylvain. B · 12 Avril 2023

En

job75 à dit:
Si le nom doit être utilisé pour rechercher la feuille il faut l'accent.

Entendu, je fait les modifications dans ce cas.
Merci beaucoup

Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date

Sylvain. B

XLDnaute Nouveau

Pièces jointes

job75

job75

XLDnaute Barbatruc

Sylvain. B

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Sylvain. B

XLDnaute Nouveau

Sylvain. B

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Sylvain. B

XLDnaute Nouveau

Discussions similaires