Sub TransposeAvecIntervalles()
Dim S As Worksheet
Dim R As Range
Dim Pas&
Dim Interv&
Dim nbLig&
Dim nbCol&
Dim var
Dim i&
Dim j&
Dim k&
Dim T()
Set R = Application.InputBox("Sélectionnez la plage à transposer.", Type:=8)
If R.Columns.Count > 1 Then
MsgBox "La plage sélectionnée ne doit contenir qu'une seule colonne."
Exit Sub
End If
Pas& = Application.InputBox("Entrez le pas entre chaque élément", Type:=1)
nbLig& = R.Rows.Count
If nbLig& Mod Pas& <> 0 Then
MsgBox "Le pas doit-être un sous-multiple du nombre de lignes de la plage sélectionnée."
Exit Sub
End If
If Pas& > nbLig& Then
MsgBox "Le pas choisi excède le nombre de lignes de la plage sélectionnée."
Exit Sub
End If
Interv& = Application.InputBox("Entrez l'intervalle de colonnes espaçant chaque info", Type:=1)
If (Pas& * (Interv& + 1)) + 1 > 256 Then
MsgBox "Le pas et l'intervalle choisis nécessitent plus de 256 colonnes."
Exit Sub
End If
var = R
nbCol& = (Interv& + 1) * (Pas& - 1) + 1
ReDim T(1 To nbLig& / Pas&, 1 To nbCol&)
j& = 1
k& = 1
For i& = 1 To nbLig&
T(j&, k&) = var(i&, 1)
k& = k& + Interv& + 1
If i& Mod Pas& = 0 Then
j& = j& + 1
k& = 1
End If
Next i&
Set S = Sheets.Add
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 1), UBound(T, 2)))
R = T
End Sub