Thema Datum  Von Nutzer Rating
Antwort
Rot Alle Tabellenblätter in intelligente Tabelle ändern
23.11.2022 11:48:10 Chris
NotSolved
23.11.2022 12:47:20 Gast29583
NotSolved
23.11.2022 13:49:35 Gast44417
Solved
23.11.2022 15:17:33 Chris
NotSolved
23.11.2022 19:16:31 Chris
NotSolved
23.11.2022 19:58:11 Gast15772
NotSolved
23.11.2022 21:21:03 Gast81588
NotSolved
23.11.2022 21:31:16 Gast2234
NotSolved
23.11.2022 22:13:24 Chris
NotSolved

Ansicht des Beitrags:
Von:
Chris
Datum:
23.11.2022 11:48:10
Views:
676
Rating: Antwort:
  Ja
Thema:
Alle Tabellenblätter in intelligente Tabelle ändern

Hallo zusammen,

ich bin zum ersten Mal hier und hoffe auf Hilfe bzw. Erläuterung. Ab und an nutze ich Makros, indem ich diese aufnehme und dann ggf. anpasse (suche mir die Einzelthemen zusammen durch Suche im www).

Allerdings komme ich bei folgender Situation nicht weiter:

Ausgangslage (Office 365):

- In eine Arbeitsmappe werden jeweils Tabellenblätter in unterschiedlicher Anzahl und unterschiedlichem Namen -jedoch mit identischem Aufbau- eingefügt. Die Arbeitsmappe besteht nun aus einem Tabellenblatt "Info" und den eingefügten Tabellenblättern.

Ziel per Makro:

- In allen Tabellenblättern (außer "Info") sollen die Zeilen 1-17 gelöscht werden.

- In allen Tabellenblättern (außer "Info") soll der Bereich "$A$1:$E$39" in eine intelligente Tabelle umgewandelt werden

- Danach sollen per M-Code in Power-Query die Daten übernommen und angepasst werden, das sollte jedoch mit der Aufnahmefunktion einfach einzubinden sein.

 

Mein Problem:

Wenn ich das Ganze aufnehme und die einzelnen Bereiche der Tabellenblätter per strg+T in eine intelligente Tabelle umwandle, wird auch der Name des Blattes einbezogen. Da dieser jedoch immer unterschiedlich ist (sei es der Name oder die Anzahl der Tabellenblätter), kann ich dies nicht dauerhaft verwenden.

 

--> Wie stelle ich ein, dass ein bestimmtes Tabellenblatt (hier "Info") ausgelassen wird und alle anderen Tabellenblätter in eine intelligente Tabelle gewandelt werden?

 

Zur Löschung der ersten 17 Zeilen würde ich das hier nehmen:

Dim WsTab As Worksheet

For Each WsTab In Sheets

    WsTab.Activate

Rows("1:17").Select

Selection.Delete

Range("A1").Select

Next WsTab

 

Bzgl. der intelligenten Tabelle ist jedoch der Name des Blattes mein Problem:

Sheets("Name 2").Select

    Application.CutCopyMode = False

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$39"), , xlYes).Name = _

        "Tabelle2"

    Range("Tabelle2[#All]").Select

 

Hier mal das gesamte aufgenommene Makro zur Info:

Sub Test()

'

    Sheets(Array("Name 1", "Name 2", "Name 3", "Name 4", "Name 5" _

        )).Select

    Sheets("Name 1").Activate

    Rows("1:17").Select

    Selection.Delete Shift:=xlUp

    Range("A1").Select

    Sheets("Name 1").Select

    Range("A1").Select

    Application.CutCopyMode = False

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$39"), , xlYes).Name = _

        "Tabelle1"

    Range("Tabelle1[#All]").Select

    Sheets("Name 2").Select

    Application.CutCopyMode = False

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$39"), , xlYes).Name = _

        "Tabelle2"

    Range("Tabelle2[#All]").Select

    Sheets("name 3").Select

    Application.CutCopyMode = False

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$39"), , xlYes).Name = _

        "Tabelle3"

    Range("Tabelle3[#All]").Select

    Sheets("Name 4").Select

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$39"), , xlYes).Name = _

        "Tabelle4"

    Range("Tabelle4[#All]").Select

    Sheets("Name 5").Select

    Application.CutCopyMode = False

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$39"), , xlYes).Name = _

        "Tabelle5"

    Range("Tabelle5[#All]").Select

    Sheets("Info").Select

    ActiveWorkbook.Queries.Add Name:="Abfrage1", Formula:= _

        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Excel.CurrentWorkbook()," & Chr(13) & "" & Chr(10) & "    #""Gefilterte Zeilen"" = Table.SelectRows(Quelle, each ([Name] = ""Tabelle1"" or [Name] = ""Tabelle2"" or [Name] = ""Tabelle3"" or [Name] = ""Tabelle4"" or [Name] = ""Tabelle5""))," & Chr(13) & "" & Chr(10) & "    #""Erweiterte Content"" = Table.ExpandTableColumn(#""Gefilterte Zeilen"", ""Content"", {""Kriterien"", ""Beschreibung"", ""Maßnahme""," & _

        " ""Nr.#(lf)programm""}, {""Kriterien"", ""Beschreibung"", ""Maßnahme"", ""Nr.#(lf)programm""})," & Chr(13) & "" & Chr(10) & "    #""Entfernte Spalten"" = Table.RemoveColumns(#""Erweiterte Content"",{""Name""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Entfernte Spalten"""

    ActiveWorkbook.Worksheets.Add

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _

        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Abfrage1;Extended Properties=""""" _

        , Destination:=Range("$A$1")).QueryTable

        .CommandType = xlCmdSql

        .CommandText = Array("SELECT * FROM [Abfrage1]")

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .BackgroundQuery = True

        .RefreshStyle = xlInsertDeleteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .PreserveColumnInfo = True

        .ListObject.DisplayName = "Abfrage1"

        .Refresh BackgroundQuery:=False

    End With

    ActiveSheet.ListObjects("Abfrage1").Range.AutoFilter Field:=3, Criteria1:= _

        "Dokumentation"

    ActiveWorkbook.Worksheets("Abfrage1").ListObjects("Abfrage1").Sort.SortFields. _

        Clear

    ActiveWorkbook.Worksheets("Abfrage1").ListObjects("Abfrage1").Sort.SortFields. _

        Add2 Key:=Range("Abfrage1[[#All],[Kriterien]]"), SortOn:=xlSortOnValues, _

        Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Abfrage1").ListObjects("Abfrage1").Sort

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    Cells.Select

    Selection.Copy

    Sheets("Ergebnis").Select

    ActiveSheet.Paste

    Range("A1").Select

End Sub

 

Im Voraus vielen vielen Dank!

 

Chris


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen