Vergleichen und Kopieren von Zeilen (unsortiert)

Hallo zusammen,
habe in 2 Tabellenblätter einer Mappe Daten stehen. Nun müssen die Spalten aus Blatt2 B-E in das Blatt1 unter Berücksichtigung jeweils des Wertes in der Spalte A zusammengefügt werden. (der Wert in Spalte A ist eine 6-stellige Zahl) Gedacht habe mir ich folgendes:
Wenn Inhalt von Spalte A(Blatt2) gleich Inhalt von SpalteA(Blatt1) dann kopiere(einfügen) Spalte B-E nach SpalteB(Blatt1).
Die ganze Sache hat aber einen Haken: die Reihenfolge von SpalteA(Blatt2) ist ungleich SpalteA(Blatt1). Es wäre auch möglich, das es keine übereinstimmenden Werte gibt. In diesem Fall sollte aber trotzdem kopiert werden.
Eine Lösung mit VBA ist erforderlich, da ich das ganze automatisieren möchte, leider habe ich keine umfangreichen Kenntnisse von VBA um das hinzukriegen.
Vielen Dank im voraus
ROlf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rolf,
die nicht übereinstimmende Werte, werden am Ende der Tabelle angefügt, in aufsteigenden Sortierung ist nicht möglich, weil, wie Du schreibst, ist die Tabelle unsortiert ist.
Gruss Beni


Sub Vergleichen_und_Kopieren()
Sheets("Tabelle2").Select
With Worksheets("Tabelle1").Columns(1)
For i = 1 To Cells(65536, 1).End(xlUp).Row
Wert = Cells(i, 1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
If C(1, 2) = "" Then Cells(i, 2).Copy Destination:=C(1, 2)
If C(1, 3) = "" Then Cells(i, 3).Copy Destination:=C(1, 3)
If C(1, 4) = "" Then Cells(i, 4).Copy Destination:=C(1, 4)
If C(1, 5) = "" Then Cells(i, 5).Copy Destination:=C(1, 5)
Else
r = .Cells(65536, 1).End(xlUp).Row + 1
Range(Cells(i, 1), Cells(i, 5)).Copy Destination:=.Cells(r, 1)
End If
Next i
End With
End Sub

Sub Spalte_opt() Dim mySpalte As Integer Dim iSpalte As Integer ' Byte Cells.Select With Selection .WrapText = False End With Range("A1").Select ' Hier die maximale Spaltenbreite einstellen Const MaxBreite = 60 mySpalte = Cells.SpecialCells(xlCellTypeLastCell).Column Range(Cells(1, 1), Cells(1, mySpalte)).EntireColumn.AutoFit For iSpalte = 1 To mySpalte If Columns(iSpalte).ColumnWidth > MaxBreite Then _ Columns(iSpalte).ColumnWidth = MaxBreite Next iSpalte End Sub

Sub Vergleichen_und_Kopieren() Sheets("Tabelle2").Select With Worksheets("Tabelle1").Columns(1) For i = 1 To Cells(65536, 1).End(xlUp).Row Wert = Cells(i, 1) Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole) If Not C Is Nothing Then Range(.Cells(i, 2), .Cells(i, 4)).Cut Destination:=C(1, 5) Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=C(1, 2) Else r = .Cells(65536, 2).End(xlUp).Row + 1 Range(Cells(i, 1), Cells(i, 5)).Copy Destination:=.Cells(r, 2) End If Next i End With End Sub

Beliebteste Forumthreads (12 Monate)

Vergleichen und Kopieren von Zeilen (unsortiert)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

32 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Vergleichen und Kopieren von Zeilen (unsortiert)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

32 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread