Keresés

Új hozzászólás Aktív témák

  • Richard

    őstag

    válasz Richard #42097 üzenetére

    Így működik:

    celtabla.DataBodyRange.End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

    Így annyi a szépséghiba, hogy a táblázat alá ugrik és amikor beilleszti a következő oszlopokat, akkor automatán kiterjeszti a táblát is.

    [ Szerkesztve ]

  • Fferi50

    őstag

    válasz Richard #42097 üzenetére

    Szia!
    Úgy tűnik, rosszul raktam össze a célba való másolást, az első másolás miatt pedig betettem egy vizsgálatot.
    If celtabla.Range(2, 1).Value = "" Then
       celtabla.Range(2, 1).PasteSpecial xlPasteValues
    Else
       celtabla.ListColumns(1).DataBodyRange.Cells(1).End(xlDown).Offset(1, 0).Paste Paste:=xlPasteValues
    End If
    Azt írtad, hogy több táblából másolsz. Ha ez kevés számú, akkor lehet egymás után többször leírni a kódot más-más táblanevekkel. De már 3 után is megéri ciklusba szervezni. A kérdés az, hogy a táblák külön-külön munkalapon vannak-e (feltételezem), de ugyanazon munkafüzetben..
    Ebben az esetben a ciklus:
    Sub a()
    Dim sh As Worksheet, tbl As ListObject
    For Each sh In Worksheets
       If sh.ListObjects.Count > 0 Then
          For Each tbl In sh.ListObjects
             With tbl
                Union(.ListColumns("Név").DataBodyRange, .ListColumns("Cím").DataBodyRange…..).Copy
             End With
             If celtabla.Range(2, 1).Value = "" Then
                celtabla.Range(2, 1).PasteSpecial xlPasteValues
             Else
                celtabla.ListColumns(1).DataBodyRange.Cells(1).End(xlDown).Offset(1, 0).Paste Paste:=xlPasteValues
             End If
          Next
       End If
    Next
    End Sub

    Üdv.
    Ps.
    "a táblázat alá ugrik és amikor beilleszti a következő oszlopokat, akkor automatán kiterjeszti a táblát is."
    Miért, nem kellene a táblázatot kiterjesztenie a beillesztett adatokra?

    [ Szerkesztve ]

Új hozzászólás Aktív témák