Discussion :

[MickaelKeul]

Bonjour,
J'ai un petit problème de code... je dois rajouté un ensemble de valeurs copier d'un tableau externe (et même de plusieurs) dans mon tableau structuré mais je voudrais que ces valeurs s'ajoute a la suite dans mon tableau structuré.
Je suis pas très doué mais j'ai eu beau chercher je trouve pas ...
(j'ai déjà lu les autos des tableau structuré, fait des essais, etc ... je sèche ..)

Merci de votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
' Copie les valeurs du classeur 1
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
 
'Colle les valeurs dans le classeur 2
Workbooks("Outil Mercu (2).xlsm").Worksheets("Base").Range("BaseArticles").PasteSpecial Paste:=xlPasteValues

[Philippe Tulliez]

Bonjour,
Si vous avez réellement lu les tutoriels traitant des tableaux structurés, vous n'appliquez certainement pas ce que vous avez appris.
Dan votre code publié, je ne vois aucune méthode, ni propriété de cet objet.
De plus si vous avez parcouru d'autres tutoriels présents sur ce site, vous auriez lu que les méthodes Select et l'objet Selection sont à proscrire dans la plupart des cas

Pour revenir à votre demande, il faudrait être plus précis sur ce que vous voulez copier (une ligne complète, plusieurs cellules non contiguës, etc.)

[ChristianBosch]

Salut, il n'est pas judicieux de faire du copier coller dans un tableau structuré (et même pas judicieux tout court, ca prend bcp de ressources pour rien).

voici une fonction qui permet d'ajouter une ligne et d'incrémenter des valeurs en fonction d'une variable tableau qui les contiens (il faut que la dimension déclarée du tableau soit la même que le nombre de colonnes du tableau structuré) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
Sub tester()
Dim MesValeurs(1 To 1) As Variant
 
MesValeurs(1) = Range("A2").Value
 
ajoutLigne MesValeurs, "BaseArticles", Worksheets("Base")
 
End Sub
 
Function ajoutLigne(CellV(), nomtab As String, feuille As Worksheet)
Dim row As ListRow
Dim Table As ListObject
Dim i As Integer
 
Set Table = feuille.ListObjects(nomtab)
Set row = Table.ListRows.Add()
 
For i = 1 To UBound(CellV)
    row.Range.Cells(i).Value = CellV(i)
Next i
 
End Function

Ici ton tableau ne contient d'une seule colonne donc la variable tableau a une dimension de 1

Il faut aussi faire attention dans tes notation, il faut toujours pointer avec l'adresse complète, ici il manque la feuille.

Tu peux utiliser la fonction pour tous les tableaux que tu veux, il faut juste respecter les règles énoncées ci dessus.

[MickaelKeul]

Merci beaucoup ! je vais tester et je vous tiens au courant.

Et désolé, je suis plus un bidouiller que vrai codeur ! j'prends (j'essaise !) sur le tas ... c'est pas facile !

[Pierre Fauconnier]

Salut.

Tu pourrais peut-être t'orienter vers Power Query, qui possède des outils de fusion de tableaux (voir mes billets sur Power Query)

[MickaelKeul]

@ChristianBosch

J'ai adapté et testé et ça marche !! ... mais ça faisait 2 ou 3 turcs un peu bizarre sur les la mise en forme et le remplissage du tableau

du coup vu que je ne suis qu'un bidouiller j'ai contourné le problème Avec le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Workbooks("Outil Mercu (3).xlsm").Worksheets("Base").Range("BaseArticles").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        End If

ça remplie le tableau a la suite des données existantes ! mais par contre ça marche pas si le tableau est vide... donc contournement et adaptation !! avec ça pour que ça marche tout le temps !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If Feuil1.ListObjects("BaseArticles").ListColumns("Code GEN").Range.Cells(2, 1).Value = "" Then
        Workbooks("Outil Mercu (3).xlsm").Worksheets("Base").Range("BaseArticles").PasteSpecial Paste:=xlPasteValues
        Else
        Workbooks("Outil Mercu (3).xlsm").Worksheets("Base").Range("BaseArticles").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        End If

J'pense que ça doit vous faire saigner les yeux car ça doit pas être académique ... mais ça marche !

@ Pierre Fauconnier

Je vais me pencher dessus merci pour le msg


Et encore merci pour vos réponses rapide ! (j'ai une autre "petite" problématique mais je vais la mettre dans un autre msg)

[ChristianBosch]

Je vois pas l’intérêt de faire du copier coller.

La fonction que je t'ai mise fonctionne même si le tableau est vide et ça ne modifie pas le format des cellules.

Et effectivement avec le power query tu devrait pouvoir faire quelque chose

[MickaelKeul]

Bon ... ça va être plus simple si je vous montre mes fichiers (test).
En fait j'ai un certain nombre de fichiers fournisseurs qui sont sur le même format et je voudrais importer dans mon fichier outil. (L'idéalisassent serait meme de le faire via un userform qui me permet de sélectionner plusieurs fichiers...)
Et je dois également exporter l'ensemble des mes données fournisseurs dans des nouveaux tableaux individuels.

voila le code pour l'importation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Sub Importer()
 
' **********************************
' Importation des données
' **********************************
 
Dim ListeFichier As Variant
Dim MonClasseur As Workbook
 
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 
    ListeFichier = Application.GetOpenFilename(Title:="Sélectionnez le Fournisseur", _
                    filefilter:="fichiers Excel(*.xls*),*xls*", buttontext:="Cliquez")
 
    If ListeFichier <> False Then
 
        Set MonClasseur = Application.Workbooks.Open(ListeFichier)
 
        'On copie les données
        Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).row, 28)).Copy
 
        ' on colle dans la feuille
        If Feuil1.ListObjects("BaseArticles").ListColumns("Code GEN").Range.Cells(2, 1).Value = "" Then
        Workbooks("Test-Outil.xlsm").Worksheets("Base").Range("BaseArticles").PasteSpecial Paste:=xlPasteValues
        Else
        Workbooks("Test-Outil.xlsm").Worksheets("Base").Range("BaseArticles").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        End If
 
        Application.DisplayAlerts = False
 
 
        MonClasseur.Close
 
    End If
 
 
 
End Sub

Et voila pour l'exportation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 
Private Sub Exporter()
 
' **********************************
' Exporter les négos Fournisseurs
' **********************************
 
    Dim Unique As Object
    Dim DerLigne As Integer, DerColonne As Integer
    Dim Plage As Range, c As Range
    Dim Valeur
 
 
    Set Unique = CreateObject("Scripting.Dictionary")
 
 
    For Each c In Feuil1.ListObjects("BaseArticles").ListColumns("Fournisseur").DataBodyRange
        If Not Unique.Exists(c.Value) Then Unique.Add c.Value, c.Value
    Next c
    For Each Valeur In Unique.keys
        Feuil1.ListObjects("BaseArticles").Range.AutoFilter Field:=2, Criteria1:=Valeur
        Workbooks.Add
                Application.Dialogs.Item(xlDialogSaveAs).Show Valeur & "_OK"
 
        Feuil1.ListObjects("baseArticles").HeaderRowRange.Copy [a1]
        Feuil1.ListObjects("baseArticles").DataBodyRange.Copy [a2]
 
        ' Masque des colonnes
 
        Range("a:c").EntireColumn.Hidden = True
 
        ' test protection cellules
            ActiveSheet.Unprotect
            Range("a1:ab2000").Locked = False
            Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).row, 22)).Select
            Selection.Locked = True
            ActiveSheet.Protect 1234
        ActiveWorkbook.Save
        ThisWorkbook.Activate
 
    Next
 
 
 
 
End Sub

pour l'import ça marche tant bien que mal ...malgré que mon codage choc

Mais a l'export ça m'exporte toutes les données a chaque .. et je comprends pas pourquoi

[Pierre Fauconnier]

Je répète que Power Query sert à cela, a priori, et permet vraiment beaucoup de choses dans lignes de code...

[Nicolas MENDEZ]

Hello à tous ...

Au final, peut importe le chemin tant qu'on arrive à l'objectif, mais il y a quand même des chemins qui sont beaucoup plus fatiguants que d'autres et je crois que la version VBA en fait partie 👀 !

Alors je rejoins à 2000% @Pierre Fauconnier sur Power Query, qui est encore assez méconnu ( Power query, pas Pierre ) et qui permet dans bien des cas de se passer de VBA.

@MickaelKeul, le fait que tu aies plusieurs fichiers avec le même format pousse encore plus vers cette piste

Dans un premier temps stocke tous tes fichiers fournisseurs individuels dans un même dossier.

Puis dans Excel, selon ta version :
- Données/Obtenir des données/A partir d'un fichier/A partir d'un dossier
- Données/Nouvelle requête/A partir d'un fichier/A partir d'un dossier

Une fois le dossier sélectionné, cliques sur Combiner/Combiner et charger à la fénêtre suivante

L'ensemble des fichiers sont empilés les uns sous les autres et le resultat est livré dans un tableau structuré... tu peux donc faire tous les TCD ou rapports Power BI que tu souhaites. CQFD

Avantage de cette solution : c'est du NO code et qui permet de garantir une compatibilité à 100% si une nouvelle colonne apparait ou disparait dans un seul des tes fichiers.
Tu évites des processus d'itérations et les lectures écritures de plages de cellules qui peuvent être très gourmands en ressources comme l'évoque @ChristianBosch --> meilleure perf si beaucoup de fichiers à traiter

En général , Power Query, l'essayer... c'est l'adopter ...

En espérant que ca soit utile