Option Explicit
Dim Col As String, Lig As Long
Sub Copiecommande()
Dim CelluleO As Range, CelluleD As Range, CelluleOL As Range, CelluleDL As Range
Dim LiDateO As Range, LiDateD As Range, RefO As Range, RefD As Range
Dim Trouve As Byte, ColO As String, ColD As String, Ligo As Long, LigD As Long
Dim ColonneAO As Range, ColonneAD As Range
'parametre a modifier en fonction des données
With Sheets(ActiveSheet.Name)
'ligne
Set LiDateO = .Range(.Cells(3, 4), .Cells(3, .Cells(3, Rows(3).Cells.Count).End(xlToLeft).Column))
'colonne
Set ColonneAO = .Range("A4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With Sheets("destination")
'ligne
Set LiDateD = .Range(.Cells(1, 2), .Cells(1, .Cells(1, Rows(31).Cells.Count).End(xlToLeft).Column))
'colonne
Set ColonneAD = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
'Recherche des lignes et colonnes
For Each CelluleO In LiDateO
If CelluleO = "" Then Exit Sub
If Not IsDate(CelluleO) Then
Call MsgBox(CelluleO & ": n'est pas une date valide jj/mm/aaaa" _
& vbCrLf & "" _
& vbCrLf & "" _
, vbCritical, "Erreur")
Exit Sub
End If
' recherche des colonnes
Recherchecolonne LiDateD, CelluleO.Value
If Col <> "" Then
ColD = Col
ColO = Replace(CelluleO.Address, CelluleO.Row, "")
ColO = Replace(ColO, "$", "")
End If
If ColD <> "" Then ' on a trouvé une colonne on recherche la igne
For Each CelluleOL In ColonneAO
If IsNumeric(CelluleOL.Value) Then
Recherchecolonne ColonneAD, CelluleOL.Value
LigD = Lig
Ligo = CelluleOL.Row
End If
'lignes colonnes
If LigD > 0 And ColD <> "" Then
.Range(ColD & LigD) = Sheets(ActiveSheet.Name).Range(ColO & Ligo)
End If
Next CelluleOL
End If
Next CelluleO
End With
End Sub
Private Sub Recherchecolonne(Plage1 As Range, Valeur1 As String)
Dim Cellule As Range
Col = "": Lig = 0
For Each Cellule In Plage1
If CStr(Cellule) = Valeur1 Then
Col = Replace(Cellule.Address, Cellule.Row, "")
Col = Replace(Col, "$", "")
Lig = Cellule.Row
Exit For
End If
Next Cellule
End Sub