XL 2021 VBA - importer des tableaux dans un fichier excel

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

imadaddy

XLDnaute Nouveau
Bonjour tout le monde,

J'ai besoin d'un grand coup de main sur un fichier excel. Je vous explique mon cas : j'ai des balances de plusieurs sociétés (1 fichier par société) que j'aimerais intégrer les unes derrières les autres dans un tableau. Actuellement, le fichier que je joins me permet de le faire sur une balance particulière c'est grâce à un internaute qui a fait tout le code VBA. Cependant, si je charge une balance différente (on l'appellera balance X car il y a plus de colonnes), la macro ne s'adapte pas à cette balance X.

Sauriez-vous ce que j'ai à changer sur le code VBA pour atteindre mon but svp ? Pour info, les balances se trouvent en feuille AD; ID; OD et sortent en format .xls.

Merci par avance pour votre aide.
Cordialement.
 

Pièces jointes

Bonjour,
Si je comprend le code existant, les onglets Ad,ID et OD représentent les feuilles "Import" d'autre classeur .
Ces feuilles sont existantes juste pour la demande et n'existent pas dans le classeur initial .

Je ne vois pas votre problème car le code semble fonctionner correctement après l'avoir adapté aux Onglets .
1737725362447.png

VB:
Sub import()
    Set Ws = ThisWorkbook.Worksheets("Import")
    If Not Ws.[T_import].ListObject.DataBodyRange Is Nothing Then Ws.[T_import].ListObject.DataBodyRange.Delete
    
    For Each sh In Worksheets(Array("id", "od", "ad"))
        With sh
            ctrl = False
            For i = 1 To .Range("B" & Rows.Count).End(xlUp).Row
              If .Range("A" & i).Value = "Livre:" Then livre = .Range("B" & i).Value
              If .Range("A" & i).Value = "Compte" Then
                ctrl = True
              ElseIf ctrl = True And .Range("A" & i) <> "" Then
                If Ws.[T_import].Item(1, 1) <> "" Then n = Ws.[T_import].Rows.Count + 1 Else n = 1
                 Ws.[T_import].Item(n, 1) = livre
                 Ws.[T_import].Item(n, 2) = .Cells(i, 1).Value
                 Ws.[T_import].Item(n, 3) = .Cells(i, 2).Value
                For j = 5 To 12
                  Ws.[T_import].Item(n, j - 1) = .Cells(i, j).Value
                Next
              ElseIf ctrl = True And .Range("A" & i) = "" Then
                Exit For
              End If
            Next
        End With
    Next
End Sub
 
Bonjour,
Si je comprend le code existant, les onglets Ad,ID et OD représentent les feuilles "Import" d'autre classeur .
Ces feuilles sont existantes juste pour la demande et n'existent pas dans le classeur initial .

Je ne vois pas votre problème car le code semble fonctionner correctement après l'avoir adapté aux Onglets .
Regarde la pièce jointe 1211587
VB:
Sub import()
    Set Ws = ThisWorkbook.Worksheets("Import")
    If Not Ws.[T_import].ListObject.DataBodyRange Is Nothing Then Ws.[T_import].ListObject.DataBodyRange.Delete
   
    For Each sh In Worksheets(Array("id", "od", "ad"))
        With sh
            ctrl = False
            For i = 1 To .Range("B" & Rows.Count).End(xlUp).Row
              If .Range("A" & i).Value = "Livre:" Then livre = .Range("B" & i).Value
              If .Range("A" & i).Value = "Compte" Then
                ctrl = True
              ElseIf ctrl = True And .Range("A" & i) <> "" Then
                If Ws.[T_import].Item(1, 1) <> "" Then n = Ws.[T_import].Rows.Count + 1 Else n = 1
                 Ws.[T_import].Item(n, 1) = livre
                 Ws.[T_import].Item(n, 2) = .Cells(i, 1).Value
                 Ws.[T_import].Item(n, 3) = .Cells(i, 2).Value
                For j = 5 To 12
                  Ws.[T_import].Item(n, j - 1) = .Cells(i, j).Value
                Next
              ElseIf ctrl = True And .Range("A" & i) = "" Then
                Exit For
              End If
            Next
        End With
    Next
End Sub
Bonjour Fanch 55 ,

Il s'agit d'adapter le tableau ID, OD et AD à la feuille import en garder les mêmes colonnes. Désolé j'ai peut-être pas été assez explicite.

Merci pour votre aide
 
Pourriez-vous me faire une concordance en ce cas, car je ne connais pas la nature des colonnes de vos tableaux :
Regarde la pièce jointe 1211592
Pourriez-vous me faire une concordance en ce cas, car je ne connais pas la nature des colonnes de vos tableaux :
Regarde la pièce jointe 1211592
Re,

En faite les intitulés de colonnes des feuilles AD, ID et OD remplacent celle de la feuilles Import sauf pour la colonne "livre". Donc le tableau s'allonge. Et comme je le disais les colonnes C et D qui sont fusionnées à la B, sont à supprimer.


Cdt
 
Dernière édition:
En fait, vous voulez fusionner les "données de table" des 3 feuilles en une table structurée de la feuille "Import" avec une colonne supplémentaire "livre" .
Le classeur que je vous joint est très adhérent aux feuilles ID,OD et AD existantes dans ce classeur,
il est probable que si les données sont en fait sur des feuilles externes, une adaptation devra être faite ...
 

Pièces jointes

En fait, vous voulez fusionner les "données de table" des 3 feuilles en une table structurée de la feuille "Import" avec une colonne supplémentaire "livre" .
Le classeur que je vous joint est très adhérent aux feuilles ID,OD et AD existantes dans ce classeur,
il est probable que si les données sont en fait sur des feuilles externes, une adaptation devra être faite ...
Bonjour Fanch55,

La macro ne fonctionne pas quand j'insère les feuilles. Attention, mes sociétés ne s'appelle pas ID, AD ou OD. J'ai anonymisé. Je vous mets le screen de ce qui bloque au niveau macro. Merci encore pour votre aide.

Capture4.JPG
 
un message d'erreur de macro (cf image ci-dessous).
Étonnant que cela fonctionne avec un message d'erreur .
Comme la macro cherche le terme "Livre:" strict en colonne "A", l'erreur indique qu'il n'a pas été trouvé et la macro s'arrête .
Le classeur ci-joint propose un contournement ...
 

Pièces jointes

Étonnant que cela fonctionne avec un message d'erreur .
Comme la macro cherche le terme "Livre:" strict en colonne "A", l'erreur indique qu'il n'a pas été trouvé et la macro s'arrête .
Le classeur ci-joint propose un contournement ...
J'ai ps encore testé votre dernier fichier. Ce qui m'étonne c'est qu'il trouve bien le livre et le colle sur toutes les lignes malgré l'erreur. Et cela sur deux/trois livres différents.

Merci encore pour votre aide je vous ferai un retour dès que je l'aurai testé.
 
Bonjour Fanch55,

Désolé pour la réponse tardive, j'étais sur d'autres travaux plus urgents. Je n'ai plus de message d'erreur de macro, donc c'est bon de ce côté. Par contre, j'ai un autre message d'erreur comme quoi il ne trouve pas le livre en $B$8 pour le livre est bien en B8. Enfin, il y a un autre problème le fichier écrase la dernière ligne par le fichier suivant. Sur ma balance j'ai 2293 lignes sur l'OD mais j'en ai que 2292 lorsque je charge la suivante et la dernière ligne ne reprend pas le livre dans la colonne A.

Capture6.JPG


Pour finir ton fichier est vachement rapide par rapport à ce que j'ai déjà.

Merci encore pour ton aide.
Cordialement.
 
Par contre, j'ai un autre message d'erreur comme quoi il ne trouve pas le livre en $B$8 pour le livre est bien en B8
Il cherche le terme strict "Livre:" en colonne "A" sinon il propose ce qui est en B8 ( cellule empirique déterminée par l'existant dans les 3 feuilles ) .

Il est probable qu'une des feuilles a en A8 un blanc supplémentaire ( la feuille est indiquée dans le titre du message ) .
1738609837811.png


Un palliatif est de chercher le terme "Livre" en tant que partie de cellule, le premier trouvé gagne .
Le palliatif est codé dans le classeur joint .

Enfin, il y a un autre problème le fichier écrase la dernière ligne par le fichier suivant
Exact, j'avais oublié une des caractéristiques d'un tableau structuré, c'est de toujours avoir une ligne de données même fictive .
Le classeur joint intègre le calcul corrigé du pointeur de ligne .
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour