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