Bonjour Jeff, Robert, le Forum
Voici une Version "Light" :
Option Explicit
Sub ReportPlage()
Dim TabPlageSource As Variant
Dim i As Integer, L As Integer
Dim C As Byte, Ctab As Byte
With Sheets("Feuil1")
TabPlageSource = .Range("A2:N" & .Range("A65536").End(xlUp).Row)
End With
Sheets("feuil2").Range("a1").CurrentRegion.Clear
L = 1
For i = 1 To UBound(TabPlageSource)
If UCase(TabPlageSource(i, 14)) = "OK" Then
For C = 1 To 3
Ctab = IIf(C = 3, 11, C + 4)
Sheets("Feuil2").Cells(L, C) = TabPlageSource(i, Ctab)
Next
L = L + 1
End If
Next
MsgBox "Done"
End Sub
Et maintenant bien qu'ayant plus de lignes de codes, voici une version "Ultra Light", puisqu'on fait tout par Dynamic Array et que l'on écrit sur la feuille en une seule fois en fin de traitement. (Plus rapide)
Sub ReportPlageByArray()
Dim TabPlageSource As Variant
Dim TabPlageCible() As String
Dim TabCibleTmp() As String
Dim i As Integer, L As Integer, x As Integer
Dim C As Byte, Ctab As Byte
With Sheets("Feuil1")
TabPlageSource = .Range("A2:N" & .Range("A65536").End(xlUp).Row)
End With
Sheets("feuil2").Range("a1").CurrentRegion.Clear
L = 1
For i = 1 To UBound(TabPlageSource)
If UCase(TabPlageSource(i, 14)) = "OK" Then
ReDim Preserve TabPlageCible(3, x)
For C = 0 To 2
Ctab = IIf(C = 2, 11, C + 5)
TabPlageCible(C, x) = TabPlageSource(i, Ctab)
Next
x = x + 1
End If
Next
ReDim TabCibleTmp(UBound(TabPlageCible, 2), 3)
For L = 0 To UBound(TabPlageCible, 2)
For C = 0 To 2
TabCibleTmp(L, C) = TabPlageCible(C, L)
Next
Next
Sheets("feuil2").Range("A1:C" & L) = TabCibleTmp()
MsgBox "Done"
End Sub
Bon Appétit
@+Thierry