meine bisgherige leistung:

Sub nr1()

x = Tabelle1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
y = Tabelle2.UsedRange.SpecialCells(xlCellTypeLastCell).Row

Sheets("Tabelle1").Select
z = 1
s = 1
For z = 1 To x
Range(Cells(z, s), Cells(z, s)).Select
Buchstabe = ActiveCell.Value
Sheets("Tabelle2").Select
z2 = 1
s2 = 1

For z2 = 1 To y
Range(Cells(z2, 1), Cells(z2, 1)).Select
Buchstabe2 = ActiveCell.Value
If Buchstabe = Buchstabe2 Then

Sheets("Tabelle2").Select

Union(Range(Cells(z2, 2), Cells(z2, 2)), _
Range(Cells(z2, 3), Cells(z2, 3)), _
Range(Cells(z2, 4), Cells(z2, 4)), _
Range(Cells(z2, 5), Cells(z2, 5)), _
Range(Cells(z2, 6), Cells(z2, 6)), _
Range(Cells(z2, 7), Cells(z2, 7))).Select
'Range(Cells(z8, 8), Cells(z8, 8))).Select
'Range(Cells(z2, 9), Cells(z2, 9))).Select

Selection.Copy

Sheets("Tabelle1").Select

Union(Range(Cells(z, 2), Cells(z, 2)), _
Range(Cells(z, 3), Cells(z, 3)), _
Range(Cells(z, 4), Cells(z, 4)), _
Range(Cells(z, 5), Cells(z, 5)), _
Range(Cells(z, 6), Cells(z, 6)), _
Range(Cells(z, 7), Cells(z, 7))).Select
'Range(Cells(z, 8), Cells(z, 8))).Select
'Range(Cells(z, 9), Cells(z, 9))).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle2").Select
End If
Next z2
Sheets("Tabelle1").Select
Next z
End Sub


bei UNION(RANGE......
kann ich nur sechs zeilen aufnehmen, ist das normal??? gibts ne alternative

ich meine zellen....

Hallo StefaninNot,

gestatte mir zum Anfang eine kleine Anmerkung. Ein Hallo am Anfang und ein Gruß am Ende würde Deinen Beitrag gleich viel netter aussehen lassen. Wenn Du zum Bäcker gehst sagst Du ja auch beim Reingehen "Guten Tag" und beim Gehen "Auf Wiedersehen". Denn die Leute, an die Du Deine Frage richtest, sitzen zwar am PC, sind aber dennoch Menschen.


Nun zu Deiner Frage: Leider ist es nicht ganz verständlich was Du mit



meinst. Das müsstest Du mal etwas genauer beschreien.

Zu Deinem Code: Was sollen die Range-Anweisungen. Du markierst mit Diner Rangeanweisung immer die gleiche Zelle. Da reicht auch anstelle von z.B.

[b]Range(Cells(z2, 2), Cells(z2, 2)) [/b]

auch ganz einfach nur

[b]Cells(z2, 2)[/b]

Außerdem musst Du die Zellen nicht mit Select markieren, sondern Du kannst sofort den Befehl .copy anfügen. Bei Dir würde das z.B. so aussehen

[b]Union(Cells(z2, 2), Cells(z2, 3), _
        Cells(z2, 4), Cells(z2, 4), _
        Cells(z2, 5), Cells(z2, 6), _
        Cells(z2, 7), Cells(z2, 8)).Copy[/b]

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Ein herzliches Hallo an Alle,
und besonders an dich Oliver!

Entschuldige bitte mein rüpelhaftes Benehmen. :-)

Habe das RANGE weggelassen so wie du es beschrieben hast, hat einwandfrei funktioniert, DANKE!

Es handelt sich um ein Makro für eine Wartungsliste.
Stell dir vor du hast in deinem ersten Tabellenblatt in der ersten Spalte Buchstaben stehen:

bsp.:

S
T
U
V

in deinem zweiten Tabellenblatt hast du das gesamte Alphabeth von A bis Z und in den Zellen daneben den dazugehörigen Text.

A - Buchstabe A
B - Buchstabe B
B - zweiter Buchstabe
C - Buchstabe C
.
.
.
S - Buchstabe S
S - Buchstabe vor dem T
S - zwei Buchstaben vor dem U
T .....
U ...
V
.
.
Z

das hatte ich gemeint mit: das Material kommt hier(zweites Tabellenblatt) mehrmals vor.....

(mein) Makro soll erkennen das es mehr "S" in der zweiten Tabelle gibt, entsprechend Platz schaffen und die neuen Texte einfügen.

Grüße
Stefano

Abend!

Damit hab ichs hinbekommen, kann da wer drüberschauen ob auch alles in Ordnung ist......

Sub nr2()
x = Tabelle3.UsedRange.SpecialCells(xlCellTypeLastCell).Row
y = Tabelle4.UsedRange.SpecialCells(xlCellTypeLastCell).Row

Sheets("Tabelle4").Select

z4 = 1
s4 = 1

For z4 = 1 To y
Cells(z4, s4).Select
buchstabe4 = ActiveCell.Value

Sheets("Tabelle3").Select

z3 = 1
s3 = 1

For z3 = 1 To x
Cells(z3, s3).Select
Buchstabe3 = ActiveCell.Value

If Buchstabe3 = buchstabe4 Then

Sheets("Tabelle4").Select

Union( _
Cells(z4, s4), _
Cells(z4, 2), Cells(z4, 3), _
Cells(z4, 4), Cells(z4, 5), _
Cells(z4, 6), Cells(z4, 7), _
Cells(z4, 8), Cells(z4, 9)).Copy

Sheets("Tabelle5").Select

z5 = 1
s5 = 1

Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Select

Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Tabelle3").Select

End If

Next z3

Sheets("Tabelle4").Select

Next z4

End Sub

Danke,
Schönen Abend noch

Stefano