Tabellen zusammenführen

Forumthread: Tabellen zusammenführen

20.05.2009 07:45:32

Florian

Hallo zusammen,
vorab: ich hab dieses Problem schon einmal hier dargestellt, konnte es aber leider nicht lösen, da meine vba kentnisse bescheidener als bescheiden sind :)
Meine 2 Probleme:
erstens:
ich möchte 2 Tabellenblätter zu einer großen Tabelle zusammenführen. Spaltennamen, Breiten und Formate sind bei beiden Tabelle identisch.
Leerzeilen soll es keine geben und die 2. Tabelle soll gleich im Anschluss an die 1. Tabelle angefügt werden.
zweitens:
Wenn die Gesamttabelle erstellt ist soll der gesamte Inhalt (Bereich A:M) ohne die Spaltenüberschriften und nur der bereich der beschrieben ist, in die Zwischenablage kopiert werden, da diese in ein anderes Programm eingefügt werden soll.
das alles soll über eine schaltfläche passieren.
Wär super wenn ihr mir irgendwie weiterhelfen könntet. eine Beispieldatei hab ich angehängt.
Danke und Gruß
Flo
https://www.herber.de/bbs/user/61921.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabellen zusammenführen

20.05.2009 08:14:03

Tino

Hallo,
versuche es mal mit diesem Code.

Option Explicit

Sub Beispiel()
Dim LRow As Long
Dim Bereich As Range


Sheets("Zusammengeführt").UsedRange.Clear

    'Datenblatt 1 ***************************************************************** 
    With Sheets("Datenblatt 1")
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .Cells.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .Cells.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
     
     Set Bereich = .Range("A1", .Cells(LRow, .Columns.Count)) 'Bereich festlegen 
    
    End With
    'Bereich kopieren 
    Bereich.Copy Sheets("Zusammengeführt").Range("A1")
    '******************************************************************************* 

    'Datenblatt 2 ****************************************************************** 
    With Sheets("Datenblatt 2")
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .Cells.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .Cells.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
     Set Bereich = .Range("A2", .Cells(LRow, .Columns.Count)) 'Bereich festlegen 
    End With
    '******************************************************************************* 

    With Sheets("Zusammengeführt")
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .Cells.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .Cells.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
      
      'Bereich kopieren 
      Bereich.Copy .Cells(LRow + 1, 1)
     
     .UsedRange.Value = .UsedRange.Value
     .UsedRange.EntireColumn.AutoFit
     .UsedRange.Copy
    End With



End Sub

Gruß Tino

AW: Tabellen zusammenführen

20.05.2009 08:29:12

Florian

Hallo Tino,
super Danke! klappt. wenn jetzt noch beim kopieren der gesamattabell die spaltenüberschriften nicht mit kopiert werden ist es perfekt.
Vielen Dank!
Gruß Flo

AW: Tabellen zusammenführen

20.05.2009 08:33:19

Tino

Hallo,
mach aus der Zeile
.UsedRange.Copy
diese
.Range("A2", .UsedRange.Cells(.UsedRange.Cells.Count)).Copy
Gruß Tino

AW: Tabellen zusammenführen

20.05.2009 09:44:18

Florian

sehr geil! Funktioniert!!! (^^)
vielen Dank!

AW: Tabellen zusammenführen

20.05.2009 10:54:53

Florian

jetzt hab ich noch ein Problem festgestellt...
die zu kopierende gesamttabelle geht bis spalte P kopiert soll aber bloß bis spalte m werden.
danke nochmal für deine Hilfe!

AW: Tabellen zusammenführen

20.05.2009 11:42:46

Tino

Hallo,
habe den Code etwas umgestellt.
Teste mal.

Option Explicit

Sub Beispiel()
Dim LRow As Long
Dim Bereich As Range


Sheets("Zusammengeführt").UsedRange.Clear

    'Datenblatt 1 ***************************************************************** 
    With Sheets("Datenblatt 1")
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .UsedRange.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .UsedRange.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
     
     Set Bereich = .Range("A1", .Cells(LRow, .Columns.Count)) 'Bereich festlegen 
    
    End With
    'Bereich kopieren 
    Bereich.Copy Sheets("Zusammengeführt").Range("A1")
    '******************************************************************************* 

    'Datenblatt 2 ****************************************************************** 
    With Sheets("Datenblatt 2")
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .UsedRange.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .UsedRange.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
     Set Bereich = .Range("A2", .Cells(LRow, .Columns.Count)) 'Bereich festlegen 
    End With
    '******************************************************************************* 

    With Sheets("Zusammengeführt")
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .UsedRange.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .UsedRange.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
      
      'Bereich kopieren 
      Bereich.Copy .Cells(LRow + 1, 1)
     
     .UsedRange.Value = .UsedRange.Value
     .UsedRange.EntireColumn.AutoFit
        
        On Error Resume Next
         'letzte Zeile bestimmen 
         LRow = .UsedRange.Find("*", , xlValues, 2, 1, 2, False, False).Row
         LRow = Application.Max(LRow, .UsedRange.Find("*", , xlFormulas, 2, 1, 2).Row)
        On Error GoTo 0
     
     .Range("A2", .Cells(LRow, 13)).Copy
    End With

End Sub

Gruß Tino

AW: Tabellen zusammenführen

20.05.2009 12:36:51

Florian

Super!
Jetzt ist es perfekt! ;)
Danke!

Historie .. Tabellen zusammenführen

20.05.2009 08:20:32

Mike

... damit die Historie nicht vergessen geht .. ;-)
https://www.herber.de/forum/messages/1075180.html
Gruss
Mike

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabellen zusammenführen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread