Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Intelligente Tabellen kopieren und umgestalten

Intelligente Tabellen kopieren und umgestalten
26.06.2019 20:12:32
Christian
Hallo an allerseits
Ich versuche mir ein Makro zusammen zu Basteln, das mir ein anderes Tabellenblatt in einer anderen Mappe auf Intelligente Tabellen überprüft diese dann filtert und kopiert. Falls es denn gesuchten Bereich nicht findet. Dann wird der Benutzte Bereich gefiltert und kopiert. Im Moment funktioniert es, so halb.
Es kopiert mir die Überschrift nicht mit. Außerdem kommt eine Meldung das eine große Menge Informationen in der zwischen Ablage sind und ob ich die behalten will. Ich weis leider nicht wie ich es weiter verbessern kann. Es würde jetzt so aussehen:
  • 
    Private Sub Tab_Aktualisieren_Test()
    Dim wksQuelle As Worksheet              'Arbeitsmappe (Datenquelle)
    Dim wksZiel As Worksheet                'Arbeitsmappe (Ziel)
    Dim lngLetzteZeile As Integer           'Letzte Zeile
    Dim Pfad As String                      'Pfad (Datenquelle)
    Dim strFilter As String                 'Filter Kriterium (Datenquelle)
    Dim strKriterium As String              'Filter Nr. (Datenquelle)
    Dim tblName As String                   'Vergebener Name für Inteligente Tabelle/Liste
    Pfad = "C:\Users\User\Desktop\Testdatei_Quelle.xlsx"
    strFilter = "1"
    strKriterium = ActiveSheet.Range("D1").Value
    tblName = "Daten"           'Name des Bereiches
    Set wksZiel = Workbooks("Testdatei.xlsm").Worksheets("Tabelle1")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With wksZiel
    lngLetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count  'Letzte benutzte Zeile ermitteln
    If lngLetzteZeile > 3 Then                                  'Prüfen ob letzte benutzte  _
    Zeile kleiner 4
    .Cells.FormatConditions.Delete
    .Range(.Rows(3), .Rows(lngLetzteZeile)).EntireRow.Delete    'Alle Zeilen ab der 4.  _
    Zeile bis zur letzten benutzten Zeile löschen
    End If
    Workbooks.Open Filename:=Pfad, ReadOnly:=True
    Set wksQuelle = Workbooks("Testdatei_Quelle.xlsx").Worksheets("Tabelle1")
    With wksQuelle
    'Prüfen ob benannte Tabelle existiert und Kopieren
    If PrüfeListObjects(wksQuelle.Parent, tblName, wksQuelle.Name) = True Then
    .ListObjects(tblName).Range.AutoFilter Field:=strFilter, Criteria1:= _
    strKriterium
    .Range(tblName).SpecialCells(xlCellTypeVisible).Copy
    wksZiel.Range("A4").PasteSpecial xlPasteAll
    Else
    'Wenn benannte Tabelle nicht existiert dann Bereich anhand des benutzten bereiches  _
    Kopieren
    .AutoFilter.ShowAllData
    .UsedRange.AutoFilter Field:=strFilter, Criteria1:=strKriterium
    .UsedRange.SpecialCells(xlCellTypeVisible).Copy wksZiel.Range("A1")
    End If
    ActiveWindow.Close SaveChanges:=False
    End With
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Aktualisiert", vbInformation
    End Sub
    

  • Ist es eigentlich möglich während des Kopierens die Spalten neu anzuordnen anhand der Überschrift? Es wäre echt großartig, wenn mir jemand etwas helfen könnte.
    Testdatei - https://www.herber.de/bbs/user/130605.xlsm
    Testdatei_Quelle (zum Abrufen der ausgangs Daten) - https://www.herber.de/bbs/user/130604.xlsx
    Grüße Christian
    Anzeige

    8
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    26.06.2019 20:15:24
    Christian
    Das ist noch die Funktion die ich mir rausgesucht hab für die Prüfung ob die Tabelle/Liste vorhanden ist.
    Private Function PrüfeListObjects(wkb As Workbook, ByVal strName As String, ByVal strSheet As  _
    String) As Boolean
    Dim objList As Object
    ' Gehe durch alle Listobjekte auf dem Tabellenblatt
    For Each objList In wkb.Worksheets(strSheet).ListObjects
    ' Wenn der Name des Listobjektes übereinstimmt, dann...
    If objList.Name = strName Then
    ' Funktion gibt Wahr zurück
    PrüfeListObjects = True
    ' Arbeit erledigt, verlasse die Funktion
    Exit Function
    Else
    ' Sonst gibt die Funktion Falsch zurück
    PrüfeListObjects = False
    End If
    Next objList
    End Function
    
    Grüße Christian
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    27.06.2019 13:53:53
    fcs
    Hallo Christian,
    Problem große Datenmenge:
    Du musst Zeile
    Application.CutCopyMode = False
    ausführen bevor die Quelldatei geschlossen wird.
    Problem Kopfzeile:
    Du musst den gleichen Zellbereich kopieren, auf den der Autofilter angewendet wird.
    Zusätzlich kann man den Code etwas einfacher/übersichtlicher gestalten, wenn man für die Quell-Arbeitsmappe(Datei) eine Objektvariable verwendet.
    Die angepassten/neuen Zeilen hab ich markiert. Für deine 2 Problem mit "!!!xxx!!!.
    Für die Optimierungen mit "###xxx###.
    LG
    Franz
    Private Sub Tab_Aktualisieren_Test()
    Dim wkbQuelle As Workbook               'Arbeitsmappe (Datenquelle) '###neu###
    Dim wksQuelle As Worksheet              'Tabellenblatt (Datenquelle)'###geändert###
    Dim wksZiel As Worksheet                'Tabellenblatt (Ziel)
    Dim lngLetzteZeile As Integer           'Letzte Zeile
    Dim Pfad As String                      'Pfad (Datenquelle)
    Dim strFilter As String                 'Filter Kriterium (Datenquelle)
    Dim strKriterium As String              'Filter Nr. (Datenquelle)
    Dim tblName As String                   'Vergebener Name für Inteligente Tabelle/Liste
    Pfad = "C:\Users\User\Desktop\Testdatei_Quelle.xlsx"
    strFilter = "1"
    strKriterium = ActiveSheet.Range("D1").Value
    tblName = "Daten"           'Name des Bereiches
    'Set wksZiel = Workbooks("Testdatei.xlsm").Worksheets("Tabelle1")
    Set wksZiel = ThisWorkbook.Worksheets("Tabelle1") '###geändert###
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With wksZiel
    lngLetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count  'Letzte benutzte Zeile ermitteln
    If lngLetzteZeile > 3 Then                                  'Prüfen ob letzte benutzte  _
    Zeile kleiner 4
    .Cells.FormatConditions.Delete
    .Range(.Rows(3), .Rows(lngLetzteZeile)).EntireRow.Delete    'Alle Zeilen ab der 4.  _
    Zeile bis zur letzten benutzten Zeile löschen
    End If
    Set wkbQuelle = Application.Workbooks.Open(Filename:=Pfad, ReadOnly:=True)  '###geändert###
    Set wksQuelle = wkbQuelle.Worksheets("Tabelle1")                            '###geändert###
    With wksQuelle
    'Prüfen ob benannte Tabelle existiert und Kopieren
    If PrüfeListObjects(wksQuelle.Parent, tblName, wksQuelle.Name) = True Then
    .ListObjects(tblName).Range.AutoFilter Field:=strFilter, Criteria1:= _
    strKriterium
    .ListObjects(tblName).Range.SpecialCells(xlCellTypeVisible).Copy      '!!!geä _
    ndert!!!
    wksZiel.Range("A4").PasteSpecial xlPasteAll
    Else
    'Wenn benannte Tabelle nicht existiert dann Bereich anhand des benutzten bereiches  _
    Kopieren
    If .AutoFilterMode = True Then If .FilterMode = True Then .AutoFilter. _
    ShowAllData
    .UsedRange.AutoFilter Field:=strFilter, Criteria1:=strKriterium
    .UsedRange.SpecialCells(xlCellTypeVisible).Copy wksZiel.Range("A1")
    End If
    Application.CutCopyMode = False                                       '!!!neu!!! _
    wkbQuelle.Close SaveChanges:=False                                    '###geä _
    ndert###
    End With
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Aktualisiert", vbInformation
    End Sub
    

    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    27.06.2019 18:01:10
    Christian
    Hallo :)
    Danke für deine Hilfe. Deine Art zu Antworten ist wirklich sehr verständlich und strukturiert, echt super. Es Funktioniert bestens und es ist jetzt auch wesentlich übersichtlicher 😊 Wenn Du oder jemand im Forum vielleicht Zeit hätte mir bei dem Makro noch etwas weiter zu helfen. Ich bin mir nicht so sicher, ob ich es allein fertigbekomme.
    Ich will in einer Variante mit dem Makro zwei bestimmte intelligente Tabellen. Aus der Quellmappe in die Zielmappe bekommen. Und in einer zweiten Variante nur bestimmte Spalten aus der Intelligenten Tabelle. Als Neue Intelligente Tabelle,in die Zielmappe. In einer bestimmten Reihenfolge übernehmen.
    Daher habe ich jede Menge Fragen:
  • Wie Prüfe ich ob die Quellmappe nicht schon geöffnet ist.Ich will bei dem Kopiervorgang nichts in der Mappe ändern aber wenn sie schon offen ist und dann geschlossen wird dann geht der Speicherstand verloren. Daran hab ich am anfang nicht gedacht. Das würde ich gerne verhindern.

  • Ist es beim Kopieren von den Intelligente Tabellen möglich sie so zu Kopieren das es in der neuen Mappe auch noch eine Intelligente Tabelle ist ev. Mit demselben oder einen anderen Namen?

  • Wüsstest du eine Möglichkeit wie ich das Makro am besten auf zwei Intelligente Tabellen ausweiten kann. Also das eine zweite Intelligente Tabellen die in derselben Quellmappe auf dem selben Tabellenblatt ist ,drei Zeilen unter die erste eingesetzt wird?

  • Und das Schwerste:Wüsstest du vielleicht eine Möglichkeit wie ich am effektivsten, nur bestimmte Spalten in einer vorgegebenen Reihenfolge aus der Quellmappe. Anhand der Überschriften in die Zielmappe bekomme. Also das ich im Code ein Array mit den Überschriften in entsprechender reichenfolge angebe bsp. auf die Überschriften in der Testdatei bezogen: Array(Daten9, Daten15, Daten20, Daten5, Daten18, Daten1)

  • Bin für jeden Input/Hilfe Dankbar.
    Grüße Christian
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    28.06.2019 11:51:02
    fcs
    Hallo Christian,
    deine Wunschliste kann man umsetzen.
    Makros siehe Textdatei.
    https://www.herber.de/bbs/user/130631.txt
    Makro Tab_Aktualisieren_Test_2_Tabs
    - prüft ob Quelle geöffnet
    - arbeitet in einer Schleife 2 "intelligente" Tabellen ab
    - wandelt die Zellbereiche mit den kopierten Daten wieder in "intelligente" Tabelle um
    Makro Tab_Aktualisieren_Test_Spalten
    kopiert zusätzlich nur die vorgegebenen Spaltentitel
    LG
    Franz
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    01.07.2019 12:48:42
    Markus
    Hallo Vielen dank für die zwei echt; super das du dir die Zeit genommen hast 
    Sie Funktionieren im Prinzip auch, es ist nur eine Codzeile dabei die mir einen Fehler verursacht und zwar erst beim Nochmaligen ausführen und zwar die hier.
    
    .ListObjects(.ListObjects.Count).Name = tblName(iTab)
    
    Es ist die Zuweisung des Namens für die Intelligenten Tabellen und sollte eigentlich Funktionieren. Hast du Vielleicht eine Idee warum es dennoch nicht geht? Und wäre es möglich das in der Quellmappe in dem Fall das die Quellmappe schon offen war der gesetzte Filter wider gelöst wird.
    Danke für die Hilfe
    Grüße Christian
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    01.07.2019 13:54:00
    fcs
    Hallo Christian,
    ich hab keine Ahnung, warum die Umbenennung der Tabellen in dem Zielblatt nicht immer funktioniert.
    Ich hab jetzt einfach eine Fehlerbehandlung eingefügt, so dass ggf. in der nächsten Zeile weitergemacht wird.
    Das Zurücksetzen des Filters in der geöffneten Quelldatei ist auch drin.
    Textdatei mit angepassten Makros
    https://www.herber.de/bbs/user/130678.txt
    LG
    Franz
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    01.07.2019 20:45:52
    Christian
    Hallo Franz
    Vielen Dank für die ganze Hilfe. Auf meinem Laptop funktioniert es. Der Fehler scheint was mit dem Pc in der Arbeit zu tun zu haben. Es ist ein Thin client system und die sind sehr langsam. Vielleicht provoziert das den Fehler. Es scheint so zu sein das er irgendwie ein Problem hat das die Intelligenten Tabellen in der Quelle und der Zielmappe gleich Heisen. Sozusagen das er auf die falsche zugreift.
    Ich werd Versuchen dem Problem Herr zu werden und vielleicht noch einen Weg suchen das Makro schneller zu machen, wenn das überhaupt geht.
    Du hast mir in jedem Fall sehr geholfen, vielen Dank dafür
    Grüße Christian
    Anzeige
    AW: Intelligente Tabellen kopieren und umgestalten
    01.07.2019 13:50:53
    Christian
    Der fehler lautet: "Anwendungs- oder Objektdefinierter Fehler"
    Grüße Christian
    ;
    Anzeige
    Anzeige

    Infobox / Tutorial

    Intelligente Tabellen kopieren und umgestalten


    Schritt-für-Schritt-Anleitung

    1. Vorbereitung der Arbeitsmappen: Stelle sicher, dass die Quell- und Zielarbeitsmappe vorbereitet sind. Du solltest wissen, welche intelligenten Tabellen du kopieren möchtest.

    2. Makro erstellen: Öffne den VBA-Editor (Alt + F11) und füge den folgenden Code ein:

      Private Sub Tab_Aktualisieren_Test()
          Dim wksQuelle As Worksheet
          Dim wksZiel As Worksheet
          Dim lngLetzteZeile As Integer
          Dim Pfad As String
          Dim strFilter As String
          Dim strKriterium As String
          Dim tblName As String
          Pfad = "C:\Users\User\Desktop\Testdatei_Quelle.xlsx"
          strFilter = "1"
          strKriterium = ActiveSheet.Range("D1").Value
          tblName = "Daten"
          Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
      
          Application.ScreenUpdating = False
          ' Hier kannst du weitere Einstellungen anpassen
      
          ' Logik zum Kopieren und Umgestalten der intelligenten Tabelle
      
          Application.ScreenUpdating = True
          MsgBox "Aktualisiert", vbInformation
      End Sub
    3. Kopieren der Daten: Überprüfe, ob die intelligente Tabelle vorhanden ist. Wenn ja, filtere die Daten und kopiere sie in die Zielarbeitsmappe.

    4. Kopfzeile kopieren: Stelle sicher, dass du den gleichen Zellbereich kopierst, auf den der Autofilter angewendet wird, um die Kopfzeile auch zu übertragen.

    5. Makro ausführen: Führe das Makro aus, um die Daten zu kopieren und umzugestalten.


    Häufige Fehler und Lösungen

    • Problem mit der Kopfzeile: Wenn die Kopfzeile nicht mitkopiert wird, stelle sicher, dass du den richtigen Zellbereich kopierst. Kopiere den gesamten Bereich der intelligenten Tabelle, nicht nur die sichtbaren Daten.

    • Fehlermeldung über große Datenmengen: Füge Application.CutCopyMode = False vor dem Schließen der Quelldatei hinzu, um diese Meldung zu vermeiden.

    • Intelligente Tabelle löschen: Wenn du eine intelligente Tabelle aus einer Arbeitsmappe entfernen möchtest, kannst du sie einfach mit der rechten Maustaste auswählen und „Intelligente Tabelle löschen“ wählen.


    Alternative Methoden

    • Datenüberprüfung: Nutze die Excel-Datenüberprüfung, um sicherzustellen, dass die Werte, die du kopierst, den gewünschten Kriterien entsprechen.

    • Direktes Kopieren: Anstatt ein Makro zu verwenden, kannst du auch die Daten manuell kopieren und in eine neue intelligente Tabelle einfügen, was jedoch weniger automatisiert ist.


    Praktische Beispiele

    Um ein Beispiel für das Kopieren von intelligenten Tabellen zu geben, kannst du zwei Tabellen aus einer Quellmappe in eine Zielmappe kopieren. Hier ist ein einfaches Beispiel:

    ' Makro zum Kopieren von zwei intelligenten Tabellen
    Private Sub KopiereZweiTabellen()
        ' Ähnlich wie im vorherigen Makro, jedoch mit einer Schleife für zwei Tabellen
    End Sub

    Tipps für Profis

    • Objektvariablen verwenden: Verwende Objektvariablen für die Quellarbeitsmappe, um den Code übersichtlicher und effizienter zu gestalten.

    • Fehlerbehandlung: Implementiere eine Fehlerbehandlung, um Probleme beim Umbenennen der intelligenten Tabellen zu vermeiden.

    • Speichere deinen Fortschritt: Stelle sicher, dass du regelmäßig speicherst, insbesondere wenn du mit großen Datenmengen arbeitest.


    FAQ: Häufige Fragen

    1. Wie prüfe ich, ob die Quellmappe bereits geöffnet ist?
    Du kannst eine einfache If-Bedingung verwenden, um zu prüfen, ob die Arbeitsmappe bereits geöffnet ist, bevor du versuchst, sie zu öffnen.

    2. Kann ich die intelligenten Tabellen beim Kopieren umbenennen?
    Ja, du kannst die Namen der intelligenten Tabellen im Zielblatt anpassen, indem du den entsprechenden Code in dein Makro einfügst.

    3. Wie kopiere ich nur bestimmte Spalten in einer bestimmten Reihenfolge?
    Du kannst ein Array verwenden, um die gewünschten Spalten anhand der Überschriften zu definieren und diese dann in der gewünschten Reihenfolge zu kopieren.

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Entdecke mehr
    Finde genau, was du suchst

    Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

    Suche nach den besten Antworten
    Unsere beliebtesten Threads

    Entdecke unsere meistgeklickten Beiträge in der Google Suche

    Top 100 Threads jetzt ansehen
    Anzeige