Simplifier un code

[anber]

Bonjour,
Peut-on simplicier le code suivant ?

Sub page()

Dim cel As Range
Dim c As Range


For Each cel In Sheets("Moa").Range("N5K5")
For Each c In Range("J3:J1167")
If c = cel Then
c.Offset(0, 1) = cel.Offset(1, 0)
End If
Next
Next
For Each cel In Sheets("Mov").Range("N5K5")
For Each c In Range("J3:J1167")
If c = cel Then
c.Offset(0, 2) = cel.Offset(1, 0)
End If
Next
Next
For Each cel In Sheets("PP").Range("N5K5")
For Each c In Range("J3:J1167")
If c = cel Then
c.Offset(0, 3) = cel.Offset(1, 0)
End If
Next
Next
For Each cel In Sheets("Che").Range("N5K5")
For Each c In Range("J3:J1167")
If c = cel Then
c.Offset(0, 4) = cel.Offset(1, 0)
End If
Next
Next
End Sub

Merci

 

[@+Thierry]

Bonsoir Anber, le Forum

Sans avoir fait de test rééls, mais juste pour le concept de l'algo :

Option Explicit

Sub Page()
Dim WS As Variant
Dim TabSource As Variant
Dim Cell As Range
Dim i As Integer
Dim Col As Byte

Col = 11
   With Sheets("TheSheetCible")
    TabSource = .Range("J3:J1167")

       For Each WS In Array("Moa", "Mov", "PP", "Che")
          For Each Cell In Sheets(WS).Range("N5K5")
             For i = 1 To UBound(TabSource)
                 If Cell = TabSource(i, 1) Then
                    .Cells(i + 2, Col) = Cell.Offset(1, 0)
                 End If
             Next i
          Next Cell
       Col = Col + 1
       Next WS
   End With

End Sub

Par contre, même si je pense que çà devrait accélérer un peu, le process risque tout de même d'être long, il faudrait voir à tout gérer par Array, mais bon là je suis en repos

Bonne Soirée
@+Thierry

 

[anber]

Bonsoir Thierry, le forum

Merci pour ta réponse que je m'empresse de tester.
J'ai souvent des problemes de genre tableau, j'ai suivi le lien vers wiki, mais je ne pas encore tout compris le principe.
Y a t il un autre lien qui explique comment gérer en array

Encore merci

BA