Coller les données d'un tableau seulement s'il a des données

Bonjour,

Merci de m'accueillir sur ce forum.

Je rencontre un problème en voulant compiler les données de tableaux présents dans plusieurs feuilles excel dans une autre feuille excel.

J'ai utilisé le code suivant pour sélectionner les données du tableau d'une feuille:

Sheets("Feuil2").Select

dl = Range("A2").CurrentRegion.End(xlDown).Row

Range("A2:D" & dl).Select

Selection.Copy

Puis celui-ci pour coller dans ma feuille "total" les données à la suite les unes des autres:

Sheets("Total").Select

Range("A2").End(xlDown)(2).Select

ActiveSheet.Paste

Seulement quand dans ma feuil3 le tableau n'a pas de données et donc uniquement des lignes vides, cela ne fonctionne plus.

Auriez-vous une solution pour sélectionner uniquement les tableaux qui ont des données?

Je cherche une solution depuis plusieurs heures mais ne trouve rien qui convienne.

Merci d'avance pour votre aide et en espérant avoir été assez clair.

Xavier

Salut Xavier,

comme ceci ?

Un double-clic sur la feuille 'Total' démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRowT, iRow%, iCol%
'
Cancel = True
Application.ScreenUpdating = False
'
Cells.Delete
Cells(1, 1) = "ITEMS"
For x = 1 To Sheets.Count
    If Sheets(x).Name <> "Total" Then
        With Sheets(x)
            iRow = .Range("A" & Rows.Count).End(xlUp).Row
            iCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
            If iRow > 1 Then
                iRowT = Range("A" & Rows.Count).End(xlUp).Row + 1
                Range("A" & iRowT).Resize(iRow - 1, iCol).Value = .Range("A2").Resize(iRow - 1, iCol).Value
            End If
        End With
    End If
Next
'
Application.ScreenUpdating = True
'
End Sub

A+

4xavier17.xlsm (22.52 Ko)

Bonjour,

Merci pour ce retour.

J'essaye dès que possible et te reviens.

Merci encore,

Xavier

Re-Bonjour Curulis57,

J'ai donc testé et la fonction fonctionne mais pas exactement comme je le voudrais. Et comme cette fonction est au dessus de mon niveau je n'arrive pas à l'adapter à mon besoin.

J'ai essayé de modifier ton fichier en PJ pour exprimer plus clairement ce que je voudrais faire. Je voudrais donc que uniquement les cellules en verts soient copiées et collées dans la feuille "total" entre la ligne de titre de mon tableau et la ligne grand total.

Sans te demander de directement résoudre mon problème car j'aimerais aussi m'exercer en le résolvant, pourrais-tu prendre un peu de temps pour m'expliquer le code que tu m'as proposée? Je débute et de cette manière je pourrais peut être arriver à l'adapter moi-même pour qu'il fonctionne sans que tu me mâches tout le boulot?

Merci encore pour ton aide,

Xavier

2xavier17-1.xlsm (14.76 Ko)

Salut Xavier,

comme ceci...

!! Tout repose sur la certitude de trouver "Grand Total" sur chaque feuille !! : il suffit de copier le bloc de valeurs (existantes ou pas) avec "Grand Total"... que j'efface avant de calculer la prochaine feuille.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRowT, iRow%, iCol%
'
Cancel = True
Application.ScreenUpdating = False
On Error Resume Next
'
Cells.Delete
Cells(1, 1) = "ITEMS"
'
For x = 1 To Sheets.Count
    If Sheets(x).Name <> "Total" Then
        With Sheets(x)
            iRow = .Range("A:A").Find(what:="Grand Total", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
            If iRow > 1 Then
                iRowT = Range("A" & Rows.Count).End(xlUp).Row + 1
                Range("A" & iRowT).Resize(iRow - 1, 2).Value = .Range("A2:B" & iRow).Value
                Range("A" & Range("A" & Rows.Count).End(xlUp).Row).Value = ""
            End If
        End With
    End If
Next
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value = "Grand Total"
'
On Error GoTo 0
Application.ScreenUpdating = True
'
End Sub

A+

Bonjour Curulis57,

Désolé de ne pas encore avoir répondu mais je n'ai pas encore eu le temps de bien tester cette solution. Je l'ai testé sur un autre tableau et ça a l'air de pas mal fonctionner.

Je te dis dès que j'ai pu l'étudier plus profondément.

Merci encore pour ton aide,

Xavier

Bonjour,

Bon ça ne fonctionne toujours pas vraiment et je n'arrive pas à modifier le code pour que ça le fasse.

Tant pis pour le moment et merci pour l'aide.

Xavier

Salut Xavier,

pas de défaitisme!

Envoie un fichier (anonyme) REEL que je puisse voir les éventuelles particularités!

A+

Bonjour,

Une proposition à étudier.

Les données sont sous forme de tableaux structurés.

La création du tableau est effectuée à l'activation de la feuille total.

Cdlt.

5xavier17-1.xlsm (22.97 Ko)
Private Sub Worksheet_Activate()
Dim ws As Worksheet, lo As ListObject, lo2 As ListObject, rCell As Range
    Application.ScreenUpdating = False
    Set lo = Me.ListObjects(1)
    If lo.InsertRowRange Is Nothing Then lo.DataBodyRange.Delete
    lo.ShowTotals = False
    Set rCell = lo.InsertRowRange.Cells(1)
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> Me.Name Then
            Set lo2 = ws.ListObjects(1)
            If lo2.InsertRowRange Is Nothing Then
                lo2.DataBodyRange.Copy
                rCell.PasteSpecial xlPasteValuesAndNumberFormats
                Set rCell = lo.HeaderRowRange.Cells(1).Offset(lo.ListRows.Count + 1)
                Application.CutCopyMode = 0
            End If
        End If
    Next ws
    lo.ShowTotals = True
End Sub

Bonjour Jean-Eric,

Merci pour ton aide.

J'ai essayé et ça m'indique que Set lo = Me.ListObjects(1) l'indice n'appartient pas à la sélection.

Bonjour Curulis57,

Je dois préparer mon fichier avant de te l'envoyer car il y a quelques infos confidentielles. Je fais ça au plus vite.

Ce qui m'embête un peu c'est que je ne comprends pas du tout vos codes. Mais j'imagine que ça viendra plus tard...

Xavier

Re,

As-tu remarqué mes commentaires ?

Soit les données mises sous forme de tableaux structurés…

Cdlt.

Jean-Eric,

Oui j'ai bien vu mais du coup, si c'est l'origine du problème, je pense n'avoir pas compris ce que tu voulais dire...

je pensais que cela signifiait que mes tableaux devaient être tous sous la même forme. Ce qui est le cas. Enfin je crois.

Merci,

Xavier

Rechercher des sujets similaires à "coller donnees tableau seulement"