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 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| Option Explicit
'--- suppose que dans les 2 fichiers:
'--- n° facture SANS DOUBLON dans aucun des 2 fichiers, non vérifié par cette macro
Sub AjoutDate()
Dim wSh1 As Worksheet, wSh2 As Worksheet
Dim rData1 As Range, rData2 As Range
Dim r As Range, rRef2 As Range
'--- initialiser
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Set wSh1 = Workbooks("Courrier test.xlsx").Worksheets("Feuil1")
Set wSh2 = ThisWorkbook.Worksheets("Feuil1")
wSh1.Cells.AutoFilter Field:=10, Criteria1:="=" '--- 10 = colonne J, date vide (dans Courrier)
wSh2.Cells.AutoFilter Field:=11, Criteria1:="<>" '--- 11 = colonne K, date non vide (dans Transfert)
Set rData1 = wSh1.UsedRange.SpecialCells(xlCellTypeVisible)
Set rData2 = wSh2.UsedRange.SpecialCells(xlCellTypeVisible)
'--- parcourir ligne par ligne le fichier "Courrier" (ligne où Date vide en colonne J)
For Each r In rData1.Rows
Application.StatusBar = r.Row
If r.Row > 3 Then '--- 3 = n° ligne de titre fichier Courrier
Debug.Print r.Address, r.Cells(1, 6).Value,
'--- r.Cells(1, 6).Value = n° facture dans fichier "Courrier"
'--- cherche cellule dans fichier "Transfert" contenant ce n° de facture
Set rRef2 = rData2.Find(r.Cells(1, 6).Value, , xlValues, xlWhole, xlByColumns) '--- 6 = colonne F
If rRef2 Is Nothing Then
Debug.Print "---"
Else
Debug.Print rRef2.Address, rRef2.Offset(0, 4).Value
r.Cells(1, 10).Value = rRef2.Offset(0, 4).Value '--- 10 = colonne J
End If
End If
Next r
'--- nettoyer
wSh1.Cells.AutoFilter
wSh2.Cells.AutoFilter
Set rData1 = Nothing
Set rData2 = Nothing
Set wSh1 = Nothing
Set wSh2 = Nothing
Application.ScreenUpdating = True
End Sub |
Partager