Creer un tableau 2 entrées

natacha

XLDnaute Occasionnel
Bonjour,
Je souhaiterais à partir d'un tableau, créer automatiquement un tableau 2 entrées .
je vous transmets en pièce jointe mon exemple .
Je vous remercie par avance.
Natacha
 

Pièces jointes

  • exemple.xls
    25 KB · Affichages: 40
  • exemple.xls
    25 KB · Affichages: 49
  • exemple.xls
    25 KB · Affichages: 48

PMO2

XLDnaute Accro
Re : Creer un tableau 2 entrées

Bonjour,

Une piste avec le code suivant
Code:
Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var
Dim T()
Dim i&
Dim j&
Dim x&
'---
On Error GoTo Erreur
If TypeName(Selection) <> "Range" Then Exit Sub
Set R = Selection
var = R
x& = ((R.Columns.Count - 1) / 2) + 1
ReDim T(1 To x&, 1 To x&)
'--- Les titres ---
For j& = 2 To x&
  T(1, j&) = var(1, j&)
  T(j&, 1) = var(1, j& + x& - 1)
Next j&
'--- Les calculs ---
For i& = 2 To UBound(T, 1)
  For j& = 2 To x&
    T(i&, j&) = var(UBound(var, 1), j&) * var(UBound(var, 1), i& + x& - 1)
  Next j&
Next i&
'--- Inscription dans une nouvelle feuille ---
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
S.Range(S.Cells(1, 1), S.Cells(UBound(T, 1), UBound(T, 2))) = T
'---
Erreur:
If Err <> 0 Then MsgBox "Erreur " & Err.Number & vbLf & Err.Description
End Sub

Sélectionnez la plage concernée (A2:G6 dans votre exemple) et lancez la macro.
Le résultat s'affiche dans une nouvelle feuille.
 

Pièces jointes

  • exemple_pmo.xls
    41 KB · Affichages: 31
  • exemple_pmo.xls
    41 KB · Affichages: 30
  • exemple_pmo.xls
    41 KB · Affichages: 34

Statistiques des forums

Discussions
312 500
Messages
2 089 013
Membres
104 004
dernier inscrit
mista