Re : Arriver aux mêmes N° de semaines
Re bonjour à tous
Après avoir analysé le code de JP, j'y ai apporté quelques modifs et le but est atteint. Voici le code modifié:
Sub recopie()
Dim i As Long
Dim nomfeuille3 As String
Dim dc1 As Integer
Dim nusema As Integer
nomfeuille3 = "Données"
Dim ligne As Long
Dim j As Integer
Dim j1 As Integer
Dim j3 As Integer
Dim nbligne As Integer
' pour toutes les semaines de la ligne 2 début colonne C
'For i = 3 To Sheets(nomfeuille3).Range("IV2").End(xlToLeft).Column
nusema = Sheets(nomfeuille3).Cells(1, 7)
' Zone 1
ligne = 2 ' ligne contenant les semaines de la zone
nbligne = 3 ' nombre de lignes dans la zone
'*******************
dc1 = Sheets(nomfeuille3).Range("IV" & ligne).End(xlToLeft).Column
For i = 3 To dc1
If nusema = Sheets(nomfeuille3).Cells(ligne, i) Then Exit For
Next i
' on deplace les colonnes
'Range(Cells(ligne, 3), Cells((ligne + nbligne - 1), dc1)).Cut Destination:=Range(Cells(ligne, i), Cells((ligne + nbligne - 1), dc1))
'recopie
If i > 3 Then ' pas de recopie si le numéro de semaine est ok
j3 = 3 'colonne C
For j = i To dc1
For j1 = ligne To ligne + nbligne - 1
Sheets(nomfeuille3).Cells(j1, j3) = Sheets(nomfeuille3).Cells(j1, j)
Next j1
j3 = j3 + 1
Next j
End If
'======================================================================
'zone 2
' recherche de la colonne contenant la semaine de la zone
'*******************
ligne = 7 ' ligne contenant les semaines de la zone
nbligne = 3 ' nombre de lignes dans la zone
'*******************
dc1 = Sheets(nomfeuille3).Range("IV" & ligne).End(xlToLeft).Column
For i = 3 To dc1
If nusema = Sheets(nomfeuille3).Cells(ligne, i) Then Exit For
Next i
' on deplace les colonnes
'Range(Cells(ligne, 3), Cells((ligne + nbligne - 1), dc1)).Cut Destination:=Range(Cells(ligne, i), Cells((ligne + nbligne - 1), dc1))
'recopie
If i > 3 Then ' pas de recopie si le numéro de semaine est ok
j3 = 3 'colonne C
For j = i To dc1
For j1 = ligne To ligne + nbligne - 1
Sheets(nomfeuille3).Cells(j1, j3) = Sheets(nomfeuille3).Cells(j1, j)
Next j1
j3 = j3 + 1
Next j
End If
'zone 3
' recherche de la colonne contenant la semaine de la zone
'*******************
ligne = 12 ' ligne contenant les semaines de la zone
nbligne = 6 ' nombre de lignes dans la zone
'*******************
dc1 = Sheets(nomfeuille3).Range("IV" & ligne).End(xlToLeft).Column
For i = 3 To dc1
If nusema = Sheets(nomfeuille3).Cells(ligne, i) Then Exit For
Next i
'recopie
If i > 3 Then ' pas de recopie si le numéro de semaine est ok
j3 = 3 'colonne C
For j = i To dc1
For j1 = ligne To ligne + nbligne - 1
Sheets(nomfeuille3).Cells(j1, j3) = Sheets(nomfeuille3).Cells(j1, j)
Next j1
j3 = j3 + 1
Next j
End If
End Sub
Merci à tous pour votre précieuse aide
@+