Bonjour Abderrahmane, BrunoM45, le forum,
En supposant que les 2 classeurs soient dans le même répertoire, que la macro (nommée TRANSFERT) soit dans un module du classeur diff....
A tester:
Function FichOuvert(F As String) As Boolean
'myDearFriend! - www.mdf-xlpages.com
On Error Resume Next
FichOuvert = Not Workbooks(F) Is Nothing
End Function
Sub TRANSFERT()
Dim tb, newtb()
Dim k&, i&
'If Not FichOuvert("matrix.xlsm") Then Workbooks.Open Filename:="C:\Users\maison\Desktop\" & "matrix.xlsm"
If Not FichOuvert("matrix.xlsm") Then Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "matrix.xlsm"
tb = Workbooks("matrix.xlsm").Sheets("matrix").Range("B7:CV" & Workbooks("matrix.xlsm").Sheets("matrix").UsedRange.Rows.Count)
Application.ScreenUpdating = False
k = 0
ReDim newtb(0 To UBound(tb, 1), 1 To 5)
For i = 1 To UBound(tb, 1)
If tb(i, 1) <> "" Then
newtb(k, 1) = tb(i, 3)
newtb(k, 3) = tb(i, 4)
newtb(k, 4) = tb(i, 10)
newtb(k, 5) = tb(i, 22)
k = k + 1
End If
Next i
If k > 0 Then
With Workbooks("diff.xlsm").Sheets("Diff")
On Error Resume Next
.Cells.Borders.LineStyle = xlLineStyleNone
.Range("A2").CurrentRegion.Offset(2, 0).ClearContents
.Range("A3").Resize(k, 5).Value = newtb: .Columns.AutoFit
.Range("A2").CurrentRegion.Offset(1, 0).Borders.Weight = xlThin
.Activate
End With
Workbooks("matrix.xlsm").Close Savechanges:=False
End If
Erase tb: Erase newtb
End Sub
Cordialement,