Anzeige
Archiv - Navigation
568to572
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
568to572
568to572
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabellen zusammenlegen

Tabellen zusammenlegen
17.02.2005 12:04:56
Elke
Mein Problem - bei der Zusammenlegung wird nur Spalte A + B berücksichtigt. Was muss ich ändern, damit bspw. die Spalten A - AS und alle Zeile berücksichtigt werden?

Sub Zusammenlegen()
Dim Mappe1 As Workbook, Mappe2 As Workbook
Dim Tabelle1 As Worksheet, Tabelle2 As Worksheet, TabelleNeu As Worksheet
Dim Range1 As Range, Range2 As Range, Zeile As Integer, Spalte As Integer
Application.ScreenUpdating = False
Set Mappe1 = Application.Workbooks("Mappe1.xls")
Set Tabelle1 = Mappe1.Worksheets("Tabelle1")
Set Range1 = Tabelle1.Range("A3").CurrentRegion
Set Mappe2 = Application.Workbooks("Mappe2.xls")
Set Tabelle2 = Mappe2.Worksheets("Tabelle1")
Set Range2 = Tabelle2.Range("A3").CurrentRegion
Set TabelleNeu = Worksheets("Tabelle1")
Spalte = Range1.Columns.Count
If Range2.Columns.Count > Spalte Then Spalte = Range2.Columns.Count
TabelleNeu.Rows(1).Font.Bold = True
TabelleNeu.Cells(1, 1) = Tabelle1.Cells(1, 1).Value
TabelleNeu.Cells(1, 2) = Tabelle1.Cells(1, 2).Value
Range1.Copy TabelleNeu.Range("A2")
Zeile = TabelleNeu.Cells(Rows.Count, 1).End(xlUp).Row + 1
Range2.Copy TabelleNeu.Cells(Zeile, 1)
TabelleNeu.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=TabelleNeu.Cells(1, TabelleNeu.UsedRange.Columns.Count + 1), _
Unique:=True
TabelleNeu.Range(TabelleNeu.Cells(1, 1), TabelleNeu.Cells(1, Spalte)). _
EntireColumn.Delete
TabelleNeu.Columns.AutoFit: TabelleNeu.Cells(2, 1).EntireRow.Insert
Sortieren
End Sub


Sub Sortieren()
Range("A3:B100").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Netikette-Verstoß, 1.Info, 2.Fragen - owT
Luc
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige