Application match

[manuBX]

Bonjour
a partir de ce fichier exemple
peut on m indiquer l utilisation de " application match "

il s agit de copier dans feuil1 sous D1 qui est une date l équivalent de la feuil2 sous la date corespondant
si je change D1 la recherche se fait pour trouver la date et copier ce qui est dessous
si la date n existe pas inscrire "pas date"

merci d avance

 

[manuBX]

Re : Application match

Bonsoir à tous
quoi modifier dans cet macro pour avoir sous D1 à D5 feuill1 la copie des lignes corespondant apres D15 à 29 feuil3(2)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
If Target.Address = "$D$1" And Target.Count = 1 Then
[D2😀500].Clear '500 arbitraire
If Not IsEmpty(Target) Then
With [Feuil2]
On Error GoTo fin
x = Application.Match([D1], .Columns(4), 0)
.Range(.Cells(x, 5), .Cells(x, 100)).Copy '100 arbitraire
Range("D2").PasteSpecial Transpose:=True
Application.CutCopyMode = False
[D2].Select
End With
End If
End If
Exit Sub

fin:
Range("D2") = "Pas de date"
End Sub
Merci d avance
A+

 

[kjin]

Re : Application match

Bonsoir,

quoi modifier dans cet macro pour avoir sous D1 à D5 feuill1 la copie des lignes corespondant apres D15 à 29 feuil3(2)

Si...vient à passer y comprendra peut-être qq chose parce que moi...
A+
kjin

 

[Pierrot93]

Re : Application match

Bonjour à tous,
Kjin🙂
pas tout compris également...
A noter au passage :

x = Application.Match([D1], .Columns(4), 0)

si la valeur n'est pas trouvée, renverra un message d'erreur...

bonne soirée
@+

 

[manuBX]

Re : Application match

Bonsoir à tous
je vais essayer de me faire comprendre et de rectifier mes erreurs
a partir de cet macro serait il possible d avoir en feuil1 sous D1 E1 F1G1H1(date) la copie de la ligne correspondant à l équivalent de la colonne4 (date)
ou si vous préférer la macro fonctionne pour D1 et il me faudrait aussi E1F1G1H1 avec les même éléments de la Feuil2
En espérant avoir été plus clair
Merci d avance
A+
If Target.Address = "$D$1" And Target.Count = 1 Then 'E1F1G1H1 aussi en plus
[D2😀500].Clear '500 arbitraire
If Not IsEmpty(Target) Then
With [Feuil2]
On Error GoTo fin
x = Application.Match([D1], .Columns(4), 0) ' ???????
.Range(.Cells(x, 5), .Cells(x, 100)).Copy ' ?????
Range("D2").PasteSpecial Transpose:=True' ????????
Application.CutCopyMode = False
[D2].Select

 

[kjin]

Re : Application match

Bonsoir,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x
If Not Intersect(Target, Range("D1:H1")) Is Nothing And Target.Count = 1 Then
Range(Target.Offset(1), Target.Offset(500)).Clear '500 arbitraire
If Not IsEmpty(Target) Then
    With [Feuil2]
        On Error GoTo fin
        x = Application.Match(Target, .Columns(4), 0)
        .Range(.Cells(x, 5), .Cells(x, 100)).Copy '100 arbitraire
        Target.Offset(1).PasteSpecial Transpose:=True
        Application.CutCopyMode = False
        Target.Offset(1).Select
    End With
End If
End If
Exit Sub

fin:
Target.Offset(1) = "Pas de date"
End Sub

A+
kjin

 

[manuBX]

Re : Application match

Merci a tous