Discussion :

[pierre3b]

Bonjour à tous,
Etant novice en macro/VBA je galère sur une macro et donc je fait appel à vous !

Je recherche à copier/coller une ligne d'une feuille à une autre avec en fonction d'une date.

C'est à dire, j'aimerais que la ligne dont la date présente dans la colonne A1 de ma "Feuille2" aille s'incrémenter sur une ligne de la date correspondante en colonne A de ma "Feuille1"

Voici un début de macro que l'on m'as proposé mais qui ne fonctionne pas ... du moins cela colle dans la Feuille1 mais uniquement si la date est présente en A2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Sub Copier()
 
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
 
 
 Sheets("Feuil1").Select
 'nom de l'onglet reception'
With ThisWorkbook.Sheets("Feuil1") 'a modifier
  i = 2
 
  Do While Cells(i, 1) <> ""
    derLig = Sheets("Feuil2").Cells(Rows.Count, i).End(xlUp).Row
    Debug.Print derLig
 
    If Sheets("Feuil1").Range("A" & i).Value = Sheets("Feuil2").Range("A" & i).Value Then
        Sheets("Feuil2").Range("B2:AN2" & derLig).Copy Destination:=Sheets("Feuil1").Cells(Rows.Count, i).End(xlUp).Offset(1, 0)
    End If
    i = i + 1
  Loop
End With
 
Application.ScreenUpdating = True
 
End Sub

Merci d'avance pour votre aide.

Pierre

[MarcelG]

Bonjour à toi, Bonjour au Forum,

Bienvenue.

Ouh la!

Au préalable, afin de le rendre plus lisible, tu peux reporter tout code en utilisant les balises #.

Il te faut construire ta démarche.

Autrement dit, pour toute date présente en colonne A de la feuille 1, rechercher son équivalent en Feuille 2.
On en déduit le processus à suivre
- Définir la plage de balayage en Feuille 1
- Définir la plage de recherche en Feuille 2
- Pour chaque cellule de la plage en Feuille 1, rechercher la cellule de la Feuille 2 retournant la même valeur de date
Cette recherche retournera une cellule (objet Range)
Si la recherche donne un résultat, soit si la recherche n'est pas "rien", alors les lignes de la Feuille 2 seront informées des valeurs de la feuille 1.

Reste à traduire ce processus en VBA.
-en utilisant la méthode Find
-en utilisant ce mode de recherche (sujet maintes fois débattu sur le forum)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Macro1()
  Dim r As Range
  Dim d As Date
 
  d = DateSerial(2018, 4, 16)
 
  Application.FindFormat.NumberFormat = "m/d/yyyy"
  Set r = Range("b1:b38").Find(What:=Format(d, "m/d/yyyy"), After:=Range("b1"), LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=True)
  If Not r Is Nothing Then MsgBox r.Address
End Sub

A adapter.

(Jusqu'alors, j'utilisais la recherche par numéro de série en modifiant, pendant la recherche, les formats de date en Long)

Tu reviens si nécessaire.

[pierre3b]

Bonjour Marcel,
Et merci pour ton retour

Cependant je n'ai pas tout compris dans ta réponse ... je suis vraiment débutant ...

Pour reformuler la macro, l'idée est de :

- définir la plage des cellules à copier de la feuille 2 : (A1:AN1)
- sur la feuille 1 : définir plage de cellule de date : (A1:A300) et recherche dans cette plage la date correspondant à la cellule A1 de la feuille 2 (format D:M:YYYY)
- une fois la date trouver => copier l'ensemble de la ligne (A1:AN1) de la feuille 2 sur la feuille 1 à la date correspondante

A savoir, tous les jours, sur la feuille 2 la date aura changé et il faudra incrémenter les nouvelles données avec la nouvelle date dans le tableau présent en feuille 1

En espérant avoir été plus claire dans ma demande ...

merci,

Pierre

[MarcelG]

Salut,

Tout à fait.
Nos post sont en phase.

En retour, et par souci d'efficacité, pourrais-tu reporter 2 copies d'écran (1 pour chaque feuille)

[pierre3b]

Feuille 2





Feuille 1

[MarcelG]

Salut,

Voici, voilou

Les données débutent en ligne 2.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub larecherchedate()
 
Dim derlign As Long
Dim laplage As Range
 
With Worksheets("Feuil1")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set laplage = .Range("A2:A" & derlign)
End With
 
Dim r As Range
Dim d As Date
 
d = Worksheets("Feuil2").Range("A2").Value
 
Application.FindFormat.NumberFormat = "m/d/yyyy"
 
Set r = laplage.Find(What:=Format(d, "m/d/yyyy"), LookIn:=xlValues, lookAt:=xlWhole)
 
If Not r Is Nothing Then
        With Worksheets("Feuil2").Range("A2:AN2")
                r.Resize(1, .Columns.Count).Value = .Value
        End With
        Set r = Nothing
End If
 
Set laplage = Nothing
 
End Sub

A noter, l'inversion des formats de date explicité dans le code VBA et celui présent dans la feuille de travail.
(gestion des dates américaines).

[pierre3b]

Super merci Marcel,
Cela fonctionne parfaitement !!!

Plus que quelques modifs à faire et le tour est joué .

Encore merci pour la solution, je vais étudier maintenant la construction de cette macro

Bonne fin d'après-midi.

Pierre

[MarcelG]

Salut,

Tu remarqueras ma modification concernant la valeur de la variable d

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

d = DateValue(Worksheets("Feuil2").Range("A2").Text)

en

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

d = Worksheets("Feuil2").Range("A2").Value

DateValue d'une date considérée en Texte, pas terrible!

je vais étudier maintenant la construction de cette macro

En effet, tu consultes le code presque mot à mot.
Pour chaque interrogation, tu effectues une recherche, d'abord sur ce forum, pour obtenir une explication qui te satisfasse.
Tu reviens éventuellement, ensuite.

Car c'est avant tout la recherche qui fait progresser (comme en mathématiques, physique...), et ce même si elle n'aboutit pas.

Bonne continuation.