XL 2019 VBA_Transformer tableau double entrée

[Spinzi]

Bonjour à toutes et à tous,

Je cherche à peaufiner le code VBA trouvé pour arriver à mon besoin.
Dans le fichier ci joint, je cherche à transformer le tableau à double entrée de l'onglet "FORMULAIRE" pour le coller au format "table" dans l'onglet "MEF".
Le bouton se trouve en ligne 30 (en dessous le tableau).

Le code trouvé fonctionne bien :

Sub FEEL_format()
Dim a, i As Long, j As Long, b(), n As Long
a = Sheets("FORMULAIRE").Range("a2").CurrentRegion.Value
ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3)
For j = 2 To UBound(a, 2)
For i = 2 To UBound(a, 1)
If Not IsEmpty(a(i, j)) Then
n = n + 1
b(n, 1) = a(i, 1)
b(n, 2) = a(1, j)
b(n, 3) = a(i, j)
End If
Next
Next
'--- Restitution
With Sheets("MEF").Cells(2, 1).Resize(n, 3)
.CurrentRegion.Offset(1, 0).ClearContents
.Value = b
End With
With Sheets("MEF").Cells(2, 1).CurrentRegion
.Sort Key1:=Sheets("MEF").Range("A2"), Order1:=1 ', Header:=xlGuess
End With

End Sub

SAUF pour 1 petite chose : je ne souhaite pas ramener la colonne B de l'onglet "MEF". Pourriez-vous m'aider ?
La solution de suppression de colonne n'est pas applicable dans le format final => il faut également que je puisse garder en cellules A1 et B1 des titres prédéfinis (voir besoin onglet "MEF") sans que la macro ne les écrase (qu'elle commence ligne 2 au final).

Merci à vous,
Spinzi

 

[laurent950]

Bonjour,
Je dirais tous simplement et très vite en corrigant cette ligne
'b(n, 2) = a(1, j) comme 1 c'est la ligne des titres et J les colonnes de tous les titres.
b(n, 2) = a(i, j)

Cdt
Laurent

 

[laurent950]

Avec une variable tableau, ci cela répond à vos intérogations, suite à votre question "
VBA_Transformer tableau double entrée"

Sub test()
Dim tabase As Variant
    tabase = Sheets("FORMULAIRE").Range("a2").CurrentRegion.Value
Dim taRes As Variant
ReDim taRes(LBound(tabase, 1) To UBound(tabase, 1), 1 To 1)
Dim cpt As Double: cpt = 1
    For i = LBound(taRes, 1) To UBound(taRes, 1)
        taRes(i, 1) = Application.Index(tabase, i)
    Next i
' dans la feuille MEF
For i = LBound(taRes) + 1 To UBound(taRes)
    'Sheets("MEF").Cells(i + cpt, 1).Resize(UBound(taRes(i, 1), 1)) = Application.Transpose(taRes(i, 1))
    'cpt = cpt + UBound(taRes(1, 1))
    For j = LBound(taRes(i, 1), 1) + 1 To UBound(taRes(i, 1), 1)
        If taRes(i, 1)(j) <> Empty Then
            Cells(cpt, 1) = taRes(i, 1)(1)
            Cells(cpt, 2) = taRes(i, 1)(j)
            cpt = cpt + 1
        End If
    Next j
Next i
End Sub

cdt
Laurent

 

[Spinzi]

Bonjour Laurent,

merci pour vos retours !

'b(n, 2) = a(1, j) comme 1 c'est la ligne des titres et J les colonnes de tous les titres.
b(n, 2) = a(i, j)
​

Cdt
Laurent​

cela fonctionne et ne m'affiche pas la colonne des titres.
Cependant, il colle parfois les données dans la feuille MEF en A1 et parfois en A2.
Aussi il m'écrase les titres qui pourraient être présents ...
Auriez vous une solution ?

Avec une variable tableau, ci cela répond à vos intérogations, suite à votre question "
VBA_Transformer tableau double entrée"
​

VB:

Copier dans le presse-papier​

Sub test()
Dim tabase As Variant
tabase = Sheets("FORMULAIRE").Range("a2").CurrentRegion.Value
Dim taRes As Variant
ReDim taRes(LBound(tabase, 1) To UBound(tabase, 1), 1 To 1)
Dim cpt As Double: cpt = 1
For i = LBound(taRes, 1) To UBound(taRes, 1)
taRes(i, 1) = Application.Index(tabase, i)
Next i
' dans la feuille MEF
For i = LBound(taRes) + 1 To UBound(taRes)
'Sheets("MEF").Cells(i + cpt, 1).Resize(UBound(taRes(i, 1), 1)) = Application.Transpose(taRes(i, 1))
'cpt = cpt + UBound(taRes(1, 1))
For j = LBound(taRes(i, 1), 1) + 1 To UBound(taRes(i, 1), 1)
If taRes(i, 1)(j) <> Empty Then
Cells(cpt, 1) = taRes(i, 1)(1)
Cells(cpt, 2) = taRes(i, 1)(j)
cpt = cpt + 1
End If
Next j
Next i
End Sub​

cdt
Laurent​

Ce code ci doit être un petit peu retravaillé car il copie les données sur l'onglet "FORMULAIRE" et non pas dans l'onglet "MEF" => il écrase la base de données.​

Merci,
A vous relire,
Spinzi

 

[laurent950]

Bonsoir,
je vous propose de me faire un copier coller se que vous avez envie d'avoir en feuille MEF et je corrige le code c'est plus simple

 

[chris]

Bonjour à tous

Si j'ai bien compris : avec PowerQuery (intégré à ta version Exel) en quelques clics
(je n'ai pas effacé ton VBA)

 

[Spinzi]

Bonjour Bonjour,

@laurent : actuellement, j'ai copié ce bout de code en essayant de l'adapter pour qu'il colle à mon besoin (je ne sais pas utiliser les tableaux et arrays en vba). De ce que j'ai compris, le programme remet les données au format tabulaire à partir de la cellule A2 de l'onglet "MEF".
Mais si je rempli les cellules A1 et B1, alors la table obtenu contient des erreurs.

@chris : merci pour ce genre de solutions ! Je n'y avais pas du tout pensé et n'avais jamais vu cette fonction "supprimer TCD".

Bien à vous,
Spinzi