AutoRange pour insertion tableau VBA

Bonjour a tous,

J'ai un petit soucis, je suis en train de monter une vba pour extraire des donnees les rendre un peu plus sympa et les copier ailleurs.

Etant donne que je n'ai aucune base en VBA j'enregistre ma macro manuellement et je check en meme temps sur microsoft basic si je fais pas trop n'importe quoi.

Bref, a un moment j'insert un tableau automatiquement il me propose la bonne taille et c' est parfait, mais evidemment dans la macro ca s'enregristre comme une zone specifique. Est-ce que c'est possible d'avoir le Range auto?

Sheets("QL").Select
    ActiveSheet.PivotTables("PivotTableQL").PivotSelect "", xlDataAndLabel, True
    Selection.Copy
    Sheets("QL Track").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:3").Select
    Range("A3").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    ActiveSheet.ListObjects.Add(xlSrcRange,[b] Range("$A$1:$M$57")[/b], , xlYes).Name = _
        "Table6"
    Range("Table6[#All]").Select

Je sais pas si j'ai reussi a me faire comprendre, si c'est le cas n'hesitez pas a me poser des questions

Par avance merci a tous !

ÉDIT: en fait que si j'applique ma macro sur un tableau de 4 cases par exemple, la vba créer automatiquement le tableau en 4x4.

Je pense que c'est possible car après avoir fait le copier-coller en A1 si on demande a insérer un tableau il reconnaît tout seul les dernières lignes et colonnes ^^

Bonjour,

A tester et adapter.

Option Explicit
Public Sub test()
Dim wsS As Worksheet, wsD As Worksheet
Dim rng As Range
Dim lo As ListObject

    Application.ScreenUpdating = False

    Set wsS = Worksheets("QL")
    Set wsD = Worksheets("QL Track")

    With wsS
        Set rng = .PivotTables("PivotTableQL").TableRange2
        rng.Copy
    End With

    With wsD
        .Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        .Rows("1:3").Delete Shift:=xlUp
        Set lo = .ListObjects.Add(xlSrcRange, .Cells(1, 1).CurrentRegion, , xlYes)
        With lo
            .Name = "Table6"
            .Comment = ""
            .TableStyle = ""
            .HeaderRowRange.Font.Bold = True
        End With
    End With

    wsD.Activate
    Cells(1, 1).Select

    Set wsS = Nothing: Set wsD = Nothing: Set rng = Nothing: Set lo = Nothing

End Sub

Hello Jean-Eric

Merci pour ta reponse !

En fait comme je vais devais trouver une solution rapido j'ai utilise une technique un peu freestyle, comme mes tableaux ont toujours le meme nombre de colonnes et que le nombre de lignes varie entre 0 et 200 a tout peter, je demande a la macro de creer un tableau de 400 et lignes et ensuite de cacher les blanks... ca a fait l'affaire.

En tout honnetete du coup j'ai pas trop le temps pour tester ton bout de macro en ce moment mais des que je devrais m'en servir je vous laisserai savoir si ca marche

Merci pour ton aide, ta technique est quand meme un peu plus pro que la mienne lol

Bonne journee a tous !

Bonjour,

Si tu n'as pas de ligne ou colonne entièrement vide :

[A1].CurrentRegion devrait le faire.

eric

Hello Eric,

Merci pour ta reponse

Bonne journee