Macro pour copier le contenu de plusieurs tableaux dans un

Bonjour,

J'ai un fichier excel avec plusieurs feuilles qui contiennent chacune un tableau de données.

Les données de ces tableaux ne sont pas toutes du même format (pas le même nombre de colones).

Je cherche un moyen pour faire un bouton qui quand appuyé, effaçe le contenu du tableau "synthèse" puis copie / colle le contenu de tous les autres tableaux dans la page synthèse, à la suite.

Sachant qu'il faudrait si possible que ça conserve les couleurs de cases...

J'ai essayé les consolidation de données, donnés dynamiques, l'assistant donnés dynamiques sans succès.

Le copier / coller :

Sheets("source1").Select

Columns("A:E").Select

Selection.Copy

Sheets("Synthese").Select

Columns("A:E").Select

ActiveSheet.Paste

Me copie colle toute la colonne bien sûr Moi je voudrais que les lignes non vides (test sur la première colone, si non vide, copier la ligne entière), et bien sûr la taille des tableaux des différentes feuille change.

Après, aucune idée de lui dire comment copier coller à la suite les données d'une feuille "source2" collées derrière celles de "source1".

Merci de toutes les idées qui pourront être amenées

Bonjour

Un fichier ,représentatif de ton fichier réel, facilitera énormément le travail de la personne qui t'apportera une solution

Bonne journée

Bonjour,

Oui bonne idée

Voila !

Bonjour

Un essai

Ca c'est de l'efficacité !!

Ca fonctionne très bien pour moi, il ne me reste plus qu'a l'adapter !

Certaines parties de la macro ne me sont pas très claires mais je vais googler tout ça, pour ne pas trop vous embêter

Merci encore

-- 05 Mai 2011, 17:18 --

Ah petit bug...

Erreur 1004 "Impossible de modifier une cellule fusionnée."

Quand je fais RAZ, ça bloque sur le .ClearContents car j'ai des cellules fusionnées

J'ai essayé quelques pistes

Sans succès

Edit 2 :

Par ailleurs la copie s'arrête à la colonne "K" Je ne vois pas cette limite dans le code

Edit 3 :

Contournement en passant par .delete

Le problème est que le bouton est supprimé aussi

Du coup j'ai modifié Sub Efface() comme tel :

Sub Efface()
  With Columns("A:Z")
    .Delete

  '  .ClearContents
  '  .Borders.LineStyle = xlNone
  '  .Interior.ColorIndex = xlNone
  End With
    ActiveSheet.Buttons.Add(47.25, 6, 177.75, 27.75).Select
    Selection.OnAction = "Maj_Synthese"
    Selection.Characters.Text = "Mise à jour tableau"
    With Selection.Characters(Start:=1, Length:=19).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
End Sub

Mais ça m'ajoute un bouton à moitié caché en haut à gauche de la feuille en plus du bouton normal??: C'est à n'y rien comprendre !

Edit suivant

Sub Efface()
  With Columns("A:Z")
    .Delete
  End With
  ActiveSheet.Buttons.Delete

    ActiveSheet.Buttons.Add(47.25, 6, 177.75, 27.75).Select
    Selection.OnAction = "Maj_Synthese"
    Selection.Characters.Text = "Mise à jour tableau"
    With Selection.Characters(Start:=1, Length:=19).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
End Sub

Crado le ActiveSheet.Buttons.Delete mais plus de fantôme de bouton !! et plus de pb avec les cellules fusionnées !

Reste le pb de la capture incomplète des autres feuilles et c'est good

edit suivant :

Résolu en fait "Col = .Range("IV1").End(xlToLeft).Column" va chercher la dernière colonne où il y a du texte sur la première ligne, et dans mon test le tableau avait un vide à droite du coup il manquait un bout pour tout ce qu'il y a en dessous.

résolu en ajoutant un "marqueur" tout à droite du tableau