Extension de boucle

Bonjour,

Je souhaiterais étendre le code ci-dessous (actuellement réalisé sur la colonne C) aux colonnes 3->14, 16->27, 29->40, 42->53, 55->66.

Pourriez-vous m'aider ?

Thomas

Sub thomas()

Dim deb As Integer, fin As Integer, k As Integer, j As Integer, truc As String

deb = 45

fin = 2131

For k = 4 To 40

For j = deb To fin Step 41

truc = truc + Range("C" & j)

Next j

Range("c" & k) = truc

deb = deb + 1

fin = fin + 1

truc = ""

Next k

End Sub

Sub thomas()
Dim deb As Integer, fin As Integer, k As Integer, j As Integer, truc As String
arr=array(15,28,41,54)
For i = 3 to 66
if not isinarray(arr,i) then
deb = 45
fin = 2131
For k = 4 To 40
For j = deb To fin Step 41
truc = truc + cells(j,i)
Next j
cells(k,i) = truc
deb = deb + 1
fin = fin + 1
truc = ""
Next k
end if
next i
End Sub

Function IsInArray(arr As Variant, valueToCheck As String, _
   Optional exactMatch As Boolean = True) As Boolean
  Dim wordList As String
  Dim startPosition As Long
  Dim nextCommaPosition As Long
  Dim matchedTerm As String

  If UBound(Filter(arr, valueToCheck)) > -1 Then
    wordList = Join(arr, ",") + ","
    ' start from the allegedly matched term ....
    startPosition = InStr(wordList, valueToCheck)
    ' get position of the comma after the allegedly matched term ...
    nextCommaPosition = InStr(startPosition + 1, wordList, ",")
    ' the alleged "match" is in between
    matchedTerm = Mid$(wordList, startPosition, _
         nextCommaPosition - startPosition)
    If exactMatch Then
      IsInArray = (StrComp(valueToCheck, matchedTerm) = 0)
    Else
      IsInArray = (StrComp(valueToCheck, matchedTerm) <> 0)
    End If
  End If
End Function