XL 2010 Transformer un Tableau à double entrée en liste en VBA

vgendron à dit:

juste cette ligne
tabInit = .Range("A1:F" & fin).Value
qui devient
tabInit = .Range("A1:H" & fin).Value

Cliquez pour agrandir...

vgendron à dit:

Hello tous !

avec ceci

VB:

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabInit = .Range("A1:F" & fin).Value
    taille = (UBound(tabInit, 1) - 2) * UBound(tabInit, 2)
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
      
    Next i
End With

With Sheets("RES")
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

Cliquez pour agrandir...

Bichette001 à dit:

Rebonjour Vgendron , j'exploite ton code et j'aimerais ajouter une condition pour l'export des résultats qui serait sous la forme suivante :
si A1= "Taux de prise" alors export vers onglet qui s'appelle "Taux de prise"
sinon si A1="Volume appels entrants" alors export vers onglet qui s'appelle "Volume appels entrants"
sinon si A1 = "appels Offerts CC" alors export vers onglet qui s'appelle "appels Offerts CC"


Tu saurais coder pour l'obtenir ou cela semble compliqué d'après toi?

Bichette

Cliquez pour agrandir...

vgendron à dit:

Hello

VB:

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row 'nb de lignes du tableau initial
    NbCol = .Range("A1").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A1").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3)
    j = 1
    For i = 2 To UBound(tabInit, 1)
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2)
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
      
    Next i
End With

With Sheets(tabInit(1, 1)) 'dans la feuille dont le nom est en cellule A1 (première cellule du tabInit)
    .UsedRange.Offset(1, 0).Clear
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

correction pour le bug: il devait y avoir un pb dans le calcul de la taille
pour le nom de la feuille. il faut qu'il soit mis en A1 à la place de date
si tu veux déplacer le tableau. il va falloir adapter le code pour calculer le nombre de lignes et de colonnes

Cliquez pour agrandir...

vgendron à dit:

Voila.. c'est bien ce que je pensais..
ton tableau de data n'est plus à la meme place. il commence en ligne 2
et en A1, tu as mis le nom de la feuille de destination..

voir code adapté

VB:

Sub Tab1toTab2()
Dim tabInit() As Variant
Dim tabFinal() As Variant

With Sheets("Data")
    FeuilleDest = .Range("A1") ' la feuille de destination est indiquée dans la cellule A1
    'on détecte les données du tableau à exporter
    NbLignes = .Range("A" & .Rows.Count).End(xlUp).Row - 1 'nb de lignes du tableau initial
    NbCol = .Range("A2").End(xlToRight).Column 'nb de colonnes
    tabInit = .Range("A2").Resize(NbLignes, NbCol).Value
    taille = (UBound(tabInit, 1) - 1) * (UBound(tabInit, 2) - 1) 'calcul du nombre de lignes du tableau final
    ReDim tabFinal(1 To taille, 1 To 3) 'on définit les dimensions du tableau final
    j = 1
    For i = 2 To UBound(tabInit, 1) 'on commence à la ligne 2 du tableau pour ignorer la ligne d'entete
        For k = LBound(tabInit, 2) + 1 To UBound(tabInit, 2) 'pour chaque colonne du tableau
            tabFinal(j, 1) = tabInit(i, 1)
            tabFinal(j, 2) = tabInit(1, k)
            tabFinal(j, 3) = tabInit(i, k)
            j = j + 1
        Next k
     
    Next i
End With

With Sheets(FeuilleDest) 'dans la feuille de destination (première cellule du tabInit)
    .UsedRange.Offset(1, 0).ClearContents 'on efface juste le contenu des cellules
    .Range("A2").Resize(UBound(tabFinal, 1), UBound(tabFinal, 2)) = tabFinal
End With
End Sub

pour les TCD..
1) je n'y connais rien
2) il faudrait au moins que tu postes ton fichier AVEC lesdits TCD

Cliquez pour agrandir...