Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1384to1388
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

Tabellen zusammenfügen -VBA

Tabellen zusammenfügen -VBA
11.10.2014 13:46:26
Werner
Liebe Community,
folgendes Problem plagt mich und ich hoffe auf brauchbare Vorschläge:
Zwei Tabellen zusammenfügen
Vorgaben:
Es handelt sich um zwei Tabellen, die aus einer unbestimmten Zahl von Datensätzen bestehen, sich aber konstant über 25 Spalten erstrecken. Die ersten 3 Zeilen sollen beim Transfer unberücksichtigt bleiben (Kopfzeilen). Die Prozedur soll so ablaufen, dass zunächst die bestehenden Datensätze der 1. Tabelle markiert, dann kopiert und in die Zieltabelle übertragen werden. Danach ist in der Zieltabelle die erste freie Zelle der Spalte A zu markieren, die Datensätze der zweiten Tabelle zu kopieren und im unmittelbaren Anschluss an die bereits übertragenen Datensätze in die Zieltabelle einzufügen.
Dazu habe ich mir aus verschiedenen Vorschlägen von Experten folgenden Makro-Code zusammengebastelt:
Public Sub Petra()
Sheets("Tabelle erste Rechnung").Select
Range(Cells(65536, 1), Cells(Cells(65536, 25).End(xlUp).Row, 25)).Select
Selection.Copy
Sheets("Testtabelle").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim rngBereich As Range, a As Range
Set rngBereich = Range("A4: A65536")
For Each a In rngBereich
If IsEmpty(a) Or a = "" Then
a.Select
Exit For
End If
Next a
Sheets("Tabelle zweite Rechnung").Select
Range(Cells(65536, 1), Cells(Cells(65536, 25).End(xlUp).Row, 25)).Select
Selection.Copy
Sheets("Testtabelle").Select
ActiveSheet.Paste
End Sub

Die Prozedur läuft zunächst einwandfrei ab (Übertragen der Daten der ersten Tabelle, Markieren der ersten freien Zelle, Markieren des Tabellenbereichs in der Zieltabelle, wo die Daten der zweiten Tabelle eingefügt werden sollen ), jedoch findet das Einfügen nicht statt.
Wo kann der Fehler liegen ?
Im Voraus herzlichen Dank für geeignete Vorschläge.

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

Betreff
Datum
Anwender
Anzeige
AW: Tabellen zusammenfügen -VBA
11.10.2014 20:12:32
Raphael
Hallo Werner,
ich habe keine Ahnung wo dein Fehler liegt....
aber ich denke so sollte es funktionieren

Sub EvtlSo()
Dim lngZeilen As Long
Dim RechWs1 As Worksheet
Dim RechWs2 As Worksheet
Dim ZielWs As Worksheet
Dim tempArr1 As Variant
Dim tempArr2 As Variant
Set RechWs1 = Sheets("Tabelle erste Rechnung")
Set RechWs2 = Sheets("Tabelle zweite Rechnung")
Set ZielWs = Sheets("Testtabelle")
'Tabelle n Array schreiben
With RechWs1
tempArr1 = .Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 25))
End With
'Tabelle in Array schreiben
With RechWs2
tempArr2 = .Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 25))
End With
'Ins Zielblatt schreiben
With ZielWs
.Cells(4, 1).Resize(UBound(tempArr1, 1), UBound(tempArr1, 2)) = tempArr1
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(tempArr2, 1), UBound( _
tempArr2, 2)) = tempArr2
End With
End Sub
Gruess
Raphael

Anzeige
AW: Tabellen zusammenfügen -VBA
11.10.2014 20:12:37
Raphael
Hallo Werner,
ich habe keine Ahnung wo dein Fehler liegt....
aber ich denke so sollte es funktionieren

Sub EvtlSo()
Dim lngZeilen As Long
Dim RechWs1 As Worksheet
Dim RechWs2 As Worksheet
Dim ZielWs As Worksheet
Dim tempArr1 As Variant
Dim tempArr2 As Variant
Set RechWs1 = Sheets("Tabelle erste Rechnung")
Set RechWs2 = Sheets("Tabelle zweite Rechnung")
Set ZielWs = Sheets("Testtabelle")
'Tabelle n Array schreiben
With RechWs1
tempArr1 = .Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 25))
End With
'Tabelle in Array schreiben
With RechWs2
tempArr2 = .Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 25))
End With
'Ins Zielblatt schreiben
With ZielWs
.Cells(4, 1).Resize(UBound(tempArr1, 1), UBound(tempArr1, 2)) = tempArr1
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(tempArr2, 1), UBound( _
tempArr2, 2)) = tempArr2
End With
End Sub
Gruess
Raphael

Anzeige
AW: Tabellen zusammenfügen -VBA
13.10.2014 18:09:08
Werner
Hallo Raphael,
zunächst herzlichen Dank für die schnelle Lösung.
Einen Änderungswunsch habe ich allerdings noch: Wenn die 'Testtabelle' vor Auslösen des Macro nicht leer ist, werden die Daten aus der'Tabelle zweite Rechnung' einfach an den letzten Datensatz der 'Testtabelle' angehängt, das heißt, sie werden (weil sie ja schon einmal vorhanden sind) mehrfach gespeichert. Die Prozedur sollte aber so ablaufen, dass zunächst alle Datensätze aus der 'Testtabelle' entfernt werden und danach die Datensätze so, wie bereits konzipiert, übertragen werden.
Herzliche Grüße
Werner

Anzeige
AW: Tabellen zusammenfügen -VBA
13.10.2014 21:36:56
Raphael
Moin,
dann erweitere unten noch um die Zeile mit .Range

With ZielWs
.range(.cells(4,1), .cells(.cells(rows.count,1).end(xlup).row,25)).clear
.Cells(4, 1).Resize(UBound(tempArr1, 1), UBound(tempArr1, 2)) = tempArr1
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(tempArr2, 1), UBound(  _
_
tempArr2, 2)) = tempArr2
End With
Gruess
Raphael

AW: Tabellen zusammenfügen -VBA
13.10.2014 23:33:57
Werner
Hallo Raphael,
alles perfekt.
Nochmals herzlichen Dank.
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige