XL 2016 VBA - Copier plusieurs lignes dans un tableau structuré

[Rhyukane]

Bonjour à tous,

J'ai régulièrement des extractions à ajouter dans ma base de données qui est un tableau structuré
Les fichiers comprenant les extractions ont toujours le même format.
Je cherche donc à copier coller les cellules du fichier d'extraction dans ma base de données.

J'arrive bien à ajouter un ligne à mon tableau de base de données et à y copier une ligne du fichier d'extraction.
Maintenant, je voudrais pouvoir compter le nombre de ligne écrites dans mon fichier d'extraction pour ajouter ce même nombre de ligne dans mon tableau structuré et les copier toutes d'un coup.

Je vous mets à la suite là ou j'en suis pour cette partie de mon code concernant ce copier coller. Je ne pense pas que vous joindre mon fichier soit pertinent puisque mon code vba va chercher des adresses de fichier dans des dossiers locaux.

Merci par avance pour votre aide

Cordialement

Rhyukane

 

[xUpsilon]

Bonjour,

Il faudrait avoir un exemple de fichieracopier pour chercher au bon endroit le nombre de lignes à copier.
Si les données sont en colonne A, tu peux aller chercher la dernière ligne avec

ws_fichieracopierfeuil1.Range("A"&Rows.Count).End(xlUp).Row

Tu peux utiliser cette fonctionnalité "Range(_).End(_)" pour pas mal de choses, renseigne toi là dessus.

Bonne journée,

 

[Robert]

Bonjour Rhyukane, bonjour le forum,

Il est fort dommage que tu envoies une capture d'écran au lieu du vrai code (ente les balises </>). Ça ne donne pas trop envie de répondre car il faut tout écrire au lieu d'utiliser ton propre code.
Pour ma part, j'utilise cette méthode que je trouve très efficace :
J'ai hésité à te faire une capture d'écran mais je n'ai pas eu le courage... Le code à adapter :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OS (à adapter à ton cas)
Set TS = OD.ListObjects(1) 'définit le tableau structuré TS (à adapter à ton cas)
Set CS = Workbooks("Fichier Extraction.xlsx") 'définit la classeur source (à adapter à ton cas)
Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adapter à ton cas)
Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL (à adapter à ton cas)
NL = PL.Rows.Count 'définit le nombre de lignes NL
Set R = TS.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TS)
If R Is Nothing Or TS.ListRows.Count = 0 Then 'si aucune occurrence n'est trouvée ou si TS ne contient pas encore de ligne
    TS.ListRows.Add 'ajoute une ligne à TS
    LI = TS.ListRows.Count 'définit la ligne LI (dernière ligne de TS)
Else 'sinon (au moins une occurrence est trouvée)
    LI = R.Row - TS.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des en-têtes de TS)
End If 'fin de alcondition
TS.Resize TS.Range.Resize(TS.ListRows.Count + NL, TS.ListColumns.Count) 'redimensionne TS
PL.Copy TS.DataBodyRange(LI, 1) 'copie la plage PL dans la donnée ligbne LI colonne 1 de TS
End Sub

[Édition]
Bonjour xUpsilon, nos posts se sont croisés...

 

[Rhyukane]

Bonjour Rhyukane, bonjour le forum,

Il est fort dommage que tu envoies une capture d'écran au lieu du vrai code (ente les balises </>). Ça ne donne pas trop envie de répondre car il faut tout écrire au lieu d'utiliser ton propre code.
Pour ma part, j'utilise cette méthode que je trouve très efficace :
J'ai hésité à te faire une capture d'écran mais je n'ai pas eu le courage... Le code à adapter :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)

Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OS (à adapter à ton cas)
Set TS = OD.ListObjects(1) 'définit le tableau structuré TS (à adapter à ton cas)
Set CS = Workbooks("Fichier Extraction.xlsx") 'définit la classeur source (à adapter à ton cas)
Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adapter à ton cas)
Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL (à adapter à ton cas)
NL = PL.Rows.Count 'définit le nombre de lignes NL
Set R = TS.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TS)
If R Is Nothing Or TS.ListRows.Count = 0 Then 'si aucune occurrence n'est trouvée ou si TS ne contient pas encore de ligne
    TS.ListRows.Add 'ajoute une ligne à TS
    LI = TS.ListRows.Count 'définit la ligne LI (dernière ligne de TS)
Else 'sinon (au moins une occurrence est trouvée)
    LI = R.Row - TS.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des en-têtes de TS)
End If 'fin de alcondition
TS.Resize TS.Range.Resize(TS.ListRows.Count + NL, TS.ListColumns.Count) 'redimensionne TS
PL.Copy TS.DataBodyRange(LI, 1) 'copie la plage PL dans la donnée ligbne LI colonne 1 de TS
End Sub

[Édition]
Bonjour xUpsilon, nos posts se sont croisés...

Bonjour Robert,

Merci beaucoup pour ton aide et désolé pour la cippe d'écran, je débute en vba et sur ce forum, je ne connaissais pas.

J'ai réussi a adapter ton code à ma situation et cela fonctionne parfaitement. Cependant, il me copie toujours l'entête de mon fichier source qui est située sur la 1er ligne même si je remplace "A1" par "A2". Il doit y avoir quelque chose que je ne comprend pas dans le code mais je n'arrive pas à l'identifier.

Aurais tu une solution ?

Merci encore pour ton aide.

 

[Rhyukane]

Bonjour,

Il faudrait avoir un exemple de fichieracopier pour chercher au bon endroit le nombre de lignes à copier.
Si les données sont en colonne A, tu peux aller chercher la dernière ligne avec

ws_fichieracopierfeuil1.Range("A"&Rows.Count).End(xlUp).Row

Tu peux utiliser cette fonctionnalité "Range(_).End(_)" pour pas mal de choses, renseigne toi là dessus.

Bonne journée,

Merci beaucoup pour ta proposition, je vais essayer de creuser cette fonctionnalité pour la suite de mes aventures en VBA

 

[Jean-Eric]

Bonjour à tous,
Une autre proposition VBA.
Cdlt.

Sub CopyData()
'Declaration des variables
Dim currentWb As Workbook, sourceWb As Workbook
Dim sourceWs As Worksheet
Dim tbl As ListObject
Dim rngData As Range, rCell As Range
Dim lastRow As Long

    'Initialisation des variables
    '-------------------------------------------------------------------------
    Set currentWb = ThisWorkbook
    Set tbl = currentWb.Worksheets(1).ListObjects(1)
    Set sourceWb = Workbooks("Fichier Extraction.xlsx")
    Set sourceWs = sourceWb.Worksheets(1)
    
    'Cellule de destination pour copie des donnees
    '-------------------------------------------------------------------------
    With tbl
        If .InsertRowRange Is Nothing Then
            Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
        Else
            Set rCell = .InsertRowRange.Cells(1)
        End If
    End With
    
    'Donnees à copier
    '-------------------------------------------------------------------------
    With sourceWs
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rngData = .Cells(2, 1).Resize(lastRow - 1, 3)
    End With
    
    'Restitution des données
    '-------------------------------------------------------------------------
    rCell.Resize(lastRow - 1, 3).Value = rngData.Value

End Sub

 

[Robert]

Bonjour le fil, bonjour le forum,

C'est le CurrentRegion qui causait ton problème. Le code de Jean-Eric le résout...

 

[Rhyukane]

Merci beaucoup pour votre aide, après un peu de travail de compréhension et de test, j'ai réussi à faire ce que je voulais avec vos 2 codes.

Merci encore pour votre aide.