Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1904to1908
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabelle automatisch generieren - Fehler

Tabelle automatisch generieren - Fehler
27.10.2022 12:45:02
Thomas
Hallo zusammen,
ich habe ein Problem. Ich möchte in einem von einer Worksheet über einen Advanced Filter eine Tabelle in auf einem anderen Worksheet erstellen. Ich habe das bei einem anderen File schonmal hinbekommen und basierend auf diesen diesen Code gemacht. Im File könnt ihr noch 2 weitere Tabellen sehen. Ziel ist es am Ende alle "1" aus "AAA" mit "2" und "3" deklarierten Zeilen aus Spalte "CCC" von AAA-FFF in EINER Tabelle auf einem anderen Worksheet "Output" darzustellen. Leider scheitere ich schon an der 1. Tabelle :)...... - schönen Dank an die Profis!!!
Userbild
der Filter ist
Userbild
Das File könnt ihr hier finden https://www.herber.de/bbs/user/155889.xlsm
Den Code den ich verwende ist folgender, und der Fehler ist angeblich in
"Sheets("Input").Range("Table1[@[AAA]:[FFF]]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Search").Range("A1:C" & lngLastRowSC), CopytoRange:=Range("A1"), Unique:=False"

Private Sub Worksheet_Activate()
Dim lngLastRow As Long
Dim lngLastRowSC As Long
Dim myRange(1) As String
lngLastRow = Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowSC = Sheets("Search").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Output").Cells.Clear
Sheets("Output").Select
Range("A1").Select
' Update in Output
Sheets("Input").Range("Table1[@[AAA]:[FFF]]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Search").Range("A1:3" & lngLastRowSC), CopytoRange:=Range("A1"), Unique:=False
myRange(1) = "A1:F"
lngLastRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row
myRange(1) = myRange(1) & lngLastRow
Sheets("Output").ListObjects.Add(xlSrcRange, Range(myRange(1)), , xlYes).Name = _
"Test_Table"
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle automatisch generieren - Fehler
27.10.2022 12:53:30
Thomas
zur Info,
Range("A1:3" & lngLastRowSC), - hier habe ich die 3 mit C ausgebessert, gleiches Problem!!!
AW: Tabelle automatisch generieren - Fehler
27.10.2022 22:38:50
ralf_b
versuch mal das.

Private Sub Worksheet_Activate()
Sheets("Output").Cells.Clear
Sheets("Input").ListObjects("Table1").Range.AutoFilter
If Sheets("Input").ListObjects("Table1").AutoFilter.FilterMode = True Then Sheets("Input").ShowAllData
With Sheets("Input").ListObjects("Table1").Range
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Search").Range("A1").CurrentRegion, _
CopytoRange:=Sheets("Output").Range("A1"), _
Unique:=False
End With
With Sheets("Output")
.Range("A1").CurrentRegion.Offset(, 7).ClearContents
.ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "Test_Table"
End With
End Sub

Anzeige
AW: Tabelle automatisch generieren - Fehler
28.10.2022 13:55:42
Thomas
Hallo Ralf,
so habe eine kleinen Workaround gemacht um mit deiner Formel arbeiten zu können. Ich mache dafür in einem neuen Sheet eine neue Tabelle in der ich nur noch "1" aus allen 3 Tabellen aufliste. Dieses Sheet mache ich mir auch über einen Button der dafür ebenfalls ein Makro ansteuert. Das klappt auch ganz gut, aber ich habe ein GROSSES Problem dabei. Sobald ich das Makro neu laufen lasse, um diese Liste nötigenfalls aufzufrischen, bekomme ich jedes mal einen "Runtime 91 - Object variable or With block variable not set" Error. Das Lustige ist, dass wenn ich dann "End" drücke, das Sheet wechsle und dann wieder neu aktiviere funktioniert es einwandfrei ganz ohne Bug...... Irgendeine Idee warum das so ist? Ich habe das File mal hochgeladen, damit du es mal anschauen kannst.
https://www.herber.de/bbs/user/155913.xlsm
Anzeige
AW: Tabelle automatisch generieren - Fehler
28.10.2022 15:02:32
GerdL
Hallo Thomas,
ich habe micht mit deinem "alten" Makro beschäftigt.

Private Sub Worksheet_Activate()
With Sheets("Output")
For i = 1 To .ListObjects.Count
.ListObjects(1).Delete
Next
.Cells.Clear
End With
With Sheets("Input")
.ListObjects("Table1").Range.AutoFilter
If .ListObjects("Table1").AutoFilter.FilterMode = True Then .ShowAllData
With .ListObjects("Table1").Range
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Search").Range("A1").CurrentRegion, _
CopytoRange:=Sheets("Output").Range("A1"), _
Unique:=False
End With
End With
With Sheets("Output")
.Range("A1").CurrentRegion.Offset(, 7).ClearContents
.ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "Test_Table"
End With
End Sub
Gruß Gerd
Anzeige
AW: Tabelle automatisch generieren - Fehler
28.10.2022 18:00:50
ralf_b
Hier mal eine neue Variante, die alle vorhandenen Listobjects(intelligente Tabellen) in Input einliest, sie jeweils filtert und nach output kopiert. Dann dort eine Intelligente Tabelle daraus erstellt.

Sub filtern()
Dim oLst   As ListObject
Dim lrow As Long
Sheets("Output").Cells.Clear
lrow = 1
With Sheets("Input")
For Each oLst In .ListObjects
oLst.Range.AutoFilter
lrow = Sheets("Output").Cells(Sheets("Output").Rows.Count, 1).End(xlUp).Row  ' letzte Zeile für Einfügen in Output.
lrow = IIf(lrow = 1, 0, lrow)  'ist notwendig für  die CopytoRange
If oLst.AutoFilter.FilterMode = True Then Sheets("Input").ShowAllData
oLst.Range.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Search").Range("A1").CurrentRegion, _
CopytoRange:=Sheets("Output").Range("A" & lrow + 1), _
Unique:=False
If lrow > 0 Then Sheets("Output").Rows(lrow + 1).Delete  'ab der 2ten Tab Spaltenzeitle löschen
Next
End With
With Sheets("Output")
.Range("A1").CurrentRegion.Offset(, 6).ClearContents  'Achtung offset 6, geht bis Spalte F
.ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "Test_Table"
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige