Thema: Zwei Tabellen ohne Duplikate in einer Dritten zusammenfassen

StandardModule: basMain

Sub ZusammenFuehren()
   Dim wks As Worksheet
   Dim rngA As Range, rngB As Range
   Dim iRow As Integer, iCounter As Integer, iCol As Integer
   Application.ScreenUpdating = False
   Set rngA = Worksheets("Tabelle1").Range("A1").CurrentRegion
   Set rngB = Worksheets("Tabelle2").Range("A1").CurrentRegion
   Set wks = Worksheets("Tabelle3")
   iCol = rngA.Columns.Count
   If rngB.Columns.Count > iCol Then
      iCol = rngB.Columns.Count
   End If
   For iCounter = 1 To iCol
      wks.Cells(1, iCounter) = "Spalte" & iCounter
   Next iCounter
   wks.Rows(1).Font.Bold = True
   rngA.Range("A1").CurrentRegion.Copy wks.Range("A2")
   iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
   rngB.Range("A1").CurrentRegion.Copy wks.Cells(iRow, 1)
   wks.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
      CopyToRange:=wks.Cells(1, wks.UsedRange.Columns.Count + 1), _
      Unique:=True
   wks.Range(wks.Cells(1, 1), wks.Cells(1, iCol)). _
      EntireColumn.Delete
   wks.Columns.AutoFit
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Vergleich