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:
945
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:

1
2
3
4
5
6
7
8
9
10
11
12
13
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:

1
2
3
4
5
6
7
8
9
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:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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